home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Taifun
/
Taifun 013 (1987-05-15)(Ossowski, Stefan)(DE)(PD).zip
/
Taifun 013 (1987-05-15)(Ossowski, Stefan)(DE)(PD).adf
/
amigaventure
/
AmigaVenture.bas
< prev
next >
Wrap
BASIC Source File
|
1987-03-04
|
102KB
|
3,524 lines
DEFINT a-z
game$ = "AmigaVenture 1.17" ' Version number of game
dataformat$ = "AmigaVenture 1.1X" ' Version number for load/save only
'
' AmigaVenture Kernal 1.17
'
' Core routines for writing an Adventure of your own
' In Microsoft AmigaBasic
'
' by Mitsu Hadeishi 7/15/86
' 1460 W. 182nd Street
' Gardena CA 90248
'
' Written for the Winner's Circle Amiga User's Group
'
'---------------------------------------------------------------------------
' Permission is given to freely distribute this code in full or in part
' provided this notice is copied IN FULL.
'
' AmigaVenture Kernal Copyright (c) 1986 by Mitsu Hadeishi
' This code may not be used in part or in full in any commercial
' product, nor may this code in part or in full be sold intentionally
' to make a profit, without an explicit written agreement with the author.
'---------------------------------------------------------------------------
'
' Please write to me if you have plans to distribute a significantly
' modified version of the *kernal*.
' Feel free to distribute *adventures* written with this kernal without
' contacting me, but please! give credit where credit is due.
'
' Updates and enhancements may be obtained from:
'
' Mitsu Hadeishi
' hadeishi@husc4.UUCP
' or hadeishi%husc4.harvard.edu
' 3 Sacramento Street
' Cambridge, MA 02138
'
' All variables are, unless otherwise indicated, short integers.
'
GOTO Initialize
Messages:
' Message subroutines/subprograms
Cannot:
IF n$(1) = "" THEN
PRINT"You can't "v$" "nn$(0)"!
ELSE
PRINT"You can't "v$" "nn$(0)" "p$" "nn$(1)"!
END IF
RETURN
SUB CantSee(nn$) STATIC
PRINT"I don't see what you're referring to.
END SUB
SUB DontHave(nn$) STATIC
PRINT"You don't have "nn$"!
END SUB
SUB CantGetAt(nn$) STATIC
PRINT"You can't get at "nn$"!"
END SUB
Absurd:
ON RND(1)*2+1 GOTO Absurd1,Absurd2
Absurd1:
PRINT"Don't be absurd.":RETURN
Absurd2:
PRINT"Don't talk nonsense.":RETURN
Mystery:
PRINT"I can't see what you're referring to.
RETURN
' Prints a list of alternatives for the player to select from
' If all the choices are positionally referenced, then "that" is
' returned as 1
SUB AskAmbig(choice(2),num,that) STATIC
SHARED adj$(),par(),rel(),prepn$()
PRINT"Which do you mean:"
num = ABS(num)
FOR i = 1 TO num
IF i = num THEN PRINT"or ";
c=choice(i,0)
CALL NameNoun(c,n$,nn$)
IF c > 0 AND adj$(c) <> "" THEN
PRINT"the "adj$(c)" "n$;
that=-1
ELSE
PRINT nn$;
END IF
IF c > 0 AND adj$(c) = "" AND par(c) <> 0 THEN
PRINT" that's "prepn$(rel(c)+1)" ";
IF that <> -1 THEN that=1
CALL NameNoun(par(c),n$,nn$)
PRINT nn$;
END IF
IF i = num THEN PRINT"?" ELSE PRINT", ";
NEXT i
IF that = -1 THEN that=0
END SUB
Calc:
'
' Calculation subprograms follow
'
' Visible() determines whether noun code 'code' is visible or not.
' If type is 1, then only checks to see if visible on the player,
' if 2, then only checks to see if visible in room (but not on player).
' Returns truth value in vis
SUB Visible(code,vis,type) STATIC
SHARED par(),rel(),opaque(),closed(),lo(),l
a = type
obj = code
IF obj < 0 THEN vis=1:EXIT SUB
vis = 0
IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB
vis = -1
WHILE (vis = -1)
IF par(obj) < 2 THEN
vis = 1
ELSEIF (opaque(rel(obj),par(obj)) = 1) AND (rel(obj) = 0 AND closed(par(obj)) <> 0) THEN
vis = 0
ELSE
obj = par(obj)
END IF
WEND
END SUB
' Avail() determines whether noun code 'code' is available or not.
' If the object is available, but you couldn't get it out from where
' it is, returns -1
' See Visible, above, for explanation of 'type'
' Returns truth value in ava
SUB Avail(code,ava,type) STATIC
SHARED par(),rel(),closed(),lo(),l,opening(),size(),holdwater()
a = type
IF a = 0 THEN a = 3
obj = code
IF obj < 0 THEN ava=1:EXIT SUB
ava = 0
IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB
siz = size(code):IF holdwater(code) = 2 THEN siz = 0
WHILE (1)
IF par(obj)<2 THEN
IF ava <> -1 THEN ava = 1
EXIT SUB
ELSEIF closed(par(obj)) <> 0 AND (rel(obj) < 2) THEN
ava = 0
EXIT SUB
ELSEIF opening(rel(obj),par(obj)) < siz THEN
ava = -1
END IF
obj = par(obj)
WEND
END SUB
'*** CheckLight() should be modified for your own program's way
'*** of casting light and shadow on the situation. Returns 0
'*** for total darkness, 1 for lamp light, 2 for moonlight/nighttime,
'*** 3 for twilight, 4 for daylight
SUB CheckLight(light) STATIC
SHARED l,lamp,lampon,day,flag(),Llight(),Lon()
light = 0
IF Lon(l) THEN light = Lon(l):EXIT SUB
IF Llight(l) = 1 AND flag(day) <> 0 THEN light = flag(day):EXIT SUB
CALL Visible(lamp,vis,0)
IF (flag(lampon) = 1) AND (vis = 1) THEN light = 1
END SUB
' NameNoun() returns appropriate strings in n$ and nn$, where
' n$ is the class word for the noun code, and nn$ is "the " + n$,
' unless the noun is abstract (negative code) in which case nn$ = n$
SUB NameNoun(n,n$,nn$) STATIC
SHARED word$(),abstract$()
IF n > 0 THEN
n$ = word$(n)
nn$ = "the " + n$
ELSE
n$ = abstract$(-n)
nn$ = n$
END IF
END SUB
Calc2:
' Places in array() siblings starting with object obj and children
' which are underneath all objects in the list.
' Starts the list at array(count + 1) (this allows you to call this
' routine multiple times and list several lists) This routine
' is used by the interpreter to list objects
SUB ListSib(obj,array(2),count(1),nn) STATIC
SHARED cc(),opaque(),right(),first()
ll = 1
cc(1) = obj
cc(0) = 0
ListSib1:
WHILE (ll > 0)
WHILE (cc(ll))
count(nn) = count(nn) + 1
array(nn,count(nn)) = cc(ll)
IF first(3,cc(ll)) <> 0 AND opaque(3,cc(ll)) = 0 THEN
ll = ll + 1
cc(ll) = first(3,cc(ll-1))
GOTO ListSib1
END IF
cc(ll) = right(cc(ll))
WEND
ll = ll - 1
cc(ll) = right(cc(ll))
WEND
END SUB
' Determines if c1 is a descendant of c2 (inside, on, etc.)
' Returns truth value in ins
SUB Inside(c1,c2,ins,rel) STATIC
SHARED par()
ins = 0
c = c1
WHILE (c)
IF par(c) = c2 THEN ins = 1:rel = rel(c):EXIT SUB
c = par(c)
WEND
END SUB
' EvalCond evaluates a condition on the flag() array; ret is the truth
' value returned. The condition tested depends on the value of b;
' it is whether or not flag(a) < c, flag(a) = c, or flag(a) > c,
' depending on whether b = -1, 0, or 1, respectively. This function
' is used to evaluate the conditionals in the map and the descriptions.
' (see Go:, Look:, and map:).
SUB EvalCond(a,b,c,ret) STATIC
SHARED flag(),random
IF a = random THEN CALL RollDice
IF b = 0 THEN
ret = (flag(a) = c)
ELSEIF b = 1 THEN
ret = (flag(a) > c)
ELSE
ret = (flag(a) < c)
END IF
END SUB
SUB RollDice STATIC
SHARED flag(),random
flag(random) = RND(1) * 100
END SUB
' List all bottles in the player's possession
' Starts at array(0), returns count in a
SUB ListBottles(array(1),a) STATIC
SHARED bottles(),lo(),nbot
a = 0
FOR i = 0 TO nbot
IF lo(bottles(i)) = 1 THEN
CALL Avail(bottles(i),ava,1)
IF ava THEN
array(a) = bottles(i)
a = a + 1
END IF
END IF
NEXT
END SUB
Lists:
' The following subprograms handle the linked lists of objects,
' parents, children, siblings
' Contents() prints a list of obj and all siblings and children
' If sing = 1, then just prints what's in it,
' not siblings
SUB Contents(obj,indent,sing) STATIC
SHARED cc(),mc(),mrel,pre$(),word$(),closed(),opaque(),right(),worn()
SHARED folded(),fold$(),first()
ll = 1
mc(1) = 0
cc(1) = obj
WHILE (ll > 0)
WHILE (cc(ll) <> 0)
Contents1:
c = cc(ll)
mode = mc(ll)
IF mode = 0 AND (sing = 0 OR ll > 1) AND c > 1 THEN
PRINT TAB(indent);pre$(c)" "word$(c);
IF folded(c) THEN
PRINT" ("fold$(folded(c))")"
ELSE
PRINT
END IF
END IF
IF first(mode,c) <> 0 AND (opaque(mode,c) = 0 OR (mode = 0 AND closed(c) = 0)) THEN
nn$ = "the " + word$(c)
PRINT TAB(indent);
IF sing = 2 THEN
' *** Don't print anything
ELSEIF mode = 0 THEN
IF c = 1 THEN
PRINT"You are wearing:"
ELSE
IF sing THEN PRINT FNcap$(nn$); ELSE PRINT nn$;
PRINT" contains:"
END IF
ELSEIF mode = 1 THEN
IF c = 1 THEN
PRINT"You are carrying:"
ELSE
IF sing THEN PRINT"W"; ELSE PRINT"w";
PRINT"rapped by "nn$", you see:"
END IF
ELSEIF mode = 2 THEN
IF sing THEN PRINT"L"; ELSE PRINT"l";
PRINT"ying on "nn$", you see:"
ELSEIF mode = 3 THEN
IF sing THEN PRINT"U"; ELSE PRINT"u";
PRINT"nder "nn$", you see:"
END IF
ll = ll + 1
cc(ll) = first(mode,c)
mc(ll) = 0
indent = indent + 3
GOTO Contents1
END IF
mc(ll) = mc(ll) + 1
IF mc(ll) > mrel THEN
IF sing THEN IF ll = 1 THEN EXIT SUB
cc(ll) = right(c)
mc(ll) = 0
END IF
WEND
ll = ll - 1
indent = indent - 3
mc(ll) = mc(ll) + 1
IF mc(ll) > mrel THEN
IF sing THEN IF ll = 1 THEN EXIT SUB
cc(ll) = right(cc(ll))
mc(ll) = 0
END IF
WEND
END SUB
' Removes object from list and places it in limbo
SUB Remove(obj) STATIC
SHARED par(),right(),left(),rel(),first(),last()
SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()
ri = right(obj)
le = left(obj)
right(le) = ri
left(ri) = le
IF par(obj) = 0 THEN
lc = lo(obj)
IF Llast(lc) = obj THEN Llast(lc) = le
IF Lfirst(lc) = obj THEN Lfirst(lc) = ri
ELSE
pa = par(obj)
IF last(rel(obj),pa) = obj THEN last(rel(obj),pa) = le
IF first(rel(obj),pa) = obj THEN first(rel(obj),pa) = ri
c = obj
w = totw(c):b = totb(c)
IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
WHILE (pa)
IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
c = par(c)
pa = par(c)
WEND
END IF
par(obj) = 0
left(obj) = 0
right(obj) = 0
lo(obj) = 0
rel(obj) = 0
END SUB
' Inserts object into relation to object "into". If into is negative
' or zero, the routine will insert it into the room number -into.
' The relation is determined by "mode". This is 0 for in, 1 for wrapped,
' 2 for on top of, and 3 for underneath (like under a table, NOT like
' under something stacked on top of the object.)
' NOTE: this routine assumes that the object has already been "Removed"
' (see above.) The routine does not do any checking for weight, capacity,
' or mode violations. This must be done by the calling routine, using the
' totw() and totb() arrays, which are updated by this routine.
SUB Insert(obj,into,mode) STATIC
SHARED par(),rel(),mrel,right(),left(),first(),last()
SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()
IF mode < 0 OR mode > mrel THEN EXIT SUB
right(obj) = 0
IF into > 0 THEN
par(obj) = into
IF first(mode,into) = 0 THEN first(mode,into) = obj
left(obj) = last(mode,into)
right(last(mode,into)) = obj
last(mode,into) = obj
rel(obj) = mode
pa = into
c = obj
w = totw(c):b = totb(c)
IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
WHILE (pa)
IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
c = par(c)
pa = par(c)
WEND
CALL Setloc(obj,lo(into),1)
ELSE
into = -into
par(obj) = 0
rel(obj) = 0
IF Lfirst(into) = 0 THEN Lfirst(into) = obj
left(obj) = Llast(into)
right(Llast(into)) = obj
Llast(into) = obj
CALL Setloc(obj,into,1)
END IF
END SUB
' Sets the location of obj and all its descendants recursively
' If sing is 0, then all siblings are set to location l as well,
' otherwise, only obj is set
SUB Setloc(obj,l,sing) STATIC
SHARED mrel,cc(),mc(),first(),right(),lo()
lo(obj) = l
ll = 1
mc(1) = 0
cc(1) = obj
WHILE (ll > 0)
WHILE (cc(ll) <> 0)
Setloc1:
c = cc(ll)
mode = mc(ll)
lo(c) = l
IF (first(mode,c) <> 0) THEN
ll = ll + 1
cc(ll) = first(mode,c)
GOTO Setloc1
END IF
mc(ll) = mc(ll) + 1
IF mc(ll) > mrel THEN
IF sing THEN IF ll = 1 THEN EXIT SUB
cc(ll) = right(cc(ll))
mc(ll) = 0
END IF
WEND
ll = ll - 1
mc(ll) = mc(ll) + 1
IF mc(ll) > mrel THEN
IF sing THEN IF ll = 1 THEN EXIT SUB
cc(ll) = right(cc(ll))
mc(ll) = 0
END IF
WEND
END SUB
' Removes the list of objects related to "code" in the relationship
' "mode" (0 - in, 1 - wrapped, 2 - on, 3 - underneath).
' Returns the first object in the list in "head".
' ***WARNING***:
' This routine DOES NOT set the location pointers, to speed up routines
' that set the location pointers themselves. Therefore the list is
' unlinked (it won't show up in a "look" or "examine", etc.) but if you
' ask whether or not the objects are visible or accessibile (with
' Visible() and Avail()) they will still be "there" in the room.
' To send them to limbo, call Setloc(head,0,0) after RemList.
SUB RemList(code,mode,head) STATIC
SHARED par(),rel(),right(),first(),last(),Lfirst(),Llast()
SHARED totw(),totb(),bulk(),size()
IF code > 0 THEN
head = first(mode,code)
first(mode,code) = 0
last(mode,code) = 0
ELSE
code = -code
head = Lfirst(code)
Lfirst(code) = 0
Llast(code) = 0
END IF
c = head
WHILE (c)
pa = par(c)
d = c
w = totw(c):b = totb(c)
IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
WHILE (pa)
IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
d = par(d)
pa = par(d)
WEND
par(c) = 0
rel(c) = 0
c = right(c)
WEND
END SUB
' Concat concatenates the list of objects beginning with "head" into
' relationship with "code" in the manner "mode". If code is
' positive, it is an object, if negative, it is a location.
' This routine typically called after RemList.
SUB Concat(head,code,mode) STATIC
SHARED lo(),par(),rel(),left(),right(),first(),last(),Lfirst(),Llast()
SHARED totw(),totb(),bulk(),size()
IF head = 0 THEN EXIT SUB
into = code
IF code <= 0 THEN mode = 0:into = 0
totw = 0:totb = 0
c = head
WHILE (c)
rel(c) = mode
par(c) = into
pa = into
d = c
w = totw(c):b = totb(c)
IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
WHILE (pa)
IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
d = par(d)
pa = par(d)
WEND
tail = c
c = right(c)
WEND
IF code > 0 THEN
left(head) = last(mode,code)
right(last(mode,code)) = head
IF first(mode,code) = 0 THEN first(mode,code) = head
last(mode,code) = tail
lc = lo(code)
ELSE
code = -code
left(head) = Llast(code)
right(Llast(code)) = head
IF Lfirst(code) = 0 THEN Lfirst(code) = head
Llast(code) = tail
lc = code
END IF
CALL Setloc(head,lc,0)
END SUB
WaterLists:
' Fill() fills the obj with the specified about of water. Returns
' the actual amount filled in wat.
SUB Fill(obj,wat) STATIC
SHARED totw(),totb(),bulk(),par(),rel(),cap(),size()
IF obj < 0 THEN EXIT SUB
IF wat = 0 THEN EXIT SUB
c=obj
IF cap(0,c)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
' Check for overflow/underflow
IF wat + bulk(0,c) > cap(0,c) THEN
wat = cap(0,c) - bulk(0,c)
IF wat < 0 THEN wat = 0:EXIT SUB
ELSEIF wat + bulk(0,c) <= 0 THEN
wat = -bulk(0,c)
CALL Empty(obj)
EXIT SUB
END IF
c = obj
IF par(c+1) = 0 THEN ' No current water object inside c
totw(c+1) = wat
totb(c+1) = wat
size(c+1) = wat
CALL Insert(c+1,c,0)
EXIT SUB
ELSE ' Must modify bulk, weight in c
totw(c+1) = totw(c+1) + wat
totb(c+1) = totw(c+1) + wat
size(c+1) = size(c+1) + wat
bulk(0,c) = bulk(0,c) + wat
WHILE (c)
totw(c) = totw(c) + wat
IF rel(c) < 3 THEN c = par(c) ELSE c = 0
WEND
END IF
END SUB
' Empties the water from object "obj". This routine DOES
' check to make sure the object IS a container
SUB Empty(obj) STATIC
SHARED holdwater(),par(),cap(),size(),totw(),totb()
IF obj < 0 THEN EXIT SUB
IF cap(0,obj)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
IF holdwater(obj) <> 1 THEN EXIT SUB
IF par(obj+1) = 0 THEN EXIT SUB
CALL Remove(obj+1)
size(obj+1) = 0
totw(obj+1) = 0
totb(obj+1) = 0
END SUB
' The Tumble routine takes all objects that are stacked on top of
' the object obj and makes them siblings of obj
SUB Tumble(obj) STATIC
SHARED cc(),c1(),c2(),lo(),par(),first(),right()
ll = 1
cc(1) = first(2,obj)
IF cc(1) = 0 THEN EXIT SUB
tum = 0
c1(tum) = obj
PRINT c1(tum)
WHILE (ll > 0)
WHILE (cc(ll) <> 0)
Tumble1:
c = cc(ll)
IF (first(2,c) <> 0) THEN
tum = tum + 1
c1(tum) = c
ll = ll + 1
cc(ll) = first(2,c)
GOTO Tumble1
END IF
cc(ll) = right(cc(ll))
WEND
ll = ll - 1
cc(ll) = right(cc(ll))
WEND
FOR i = 0 TO tum
CALL RemList(c1(i),2,c2(i))
NEXT i
lc = par(obj)
IF lc = 0 THEN lc = -lo(obj)
FOR i = 0 TO tum
CALL Concat(c2(i),lc,0)
NEXT i
END SUB
'
' Interpreter subprograms follow
'
Interpreter:
' GetVerb() returns a verb code in v and a verb string in v$,
' and returns cmd$ starting with the first word following the verb phrase
SUB GetVerb(cmd$,v,v$) STATIC
SHARED verb$()
IF cmd$ = "" THEN EXIT SUB
cc(3) = -1
FOR i = 2 TO 0 STEP -1
cc(i) = INSTR(cc(i+1)+2,cmd$," ") - 1
NEXT i
FOR i = 0 TO 2 '*** Search 3-word, 2-word, then 1-word verb lists
IF cc(i) < 0 THEN GetVerb1
c$ = "," + LEFT$(cmd$,cc(i)) + ","
c = INSTR(verb$(i),c$)
IF c <> 0 THEN vl = i:i = 2
GetVerb1:
NEXT i
IF c = 0 THEN
EXIT SUB
ELSE
v$ = MID$(c$,2,LEN(c$) - 2)
lv = LEN(v$)
v = VAL(MID$(verb$(vl),c + lv + 2))
cmd$ = MID$(cmd$,lv + 2)
WHILE (MID$(cmd$,1,1) = " ")
cmd$ = MID$(cmd$,2)
WEND
END IF
END SUB
' ExNoun() returns an array of noun code choices and a count
' Returns 0 in nch if no noun is found
' Returns -1 if inconsistent nouns are found (like "diamond sandwich", etc.)
' Returns 1 in "that" if a "that" clause is identified
' Note: this routine exits immediately after ambiguity is resolved.
' This routine truncates cmd$
SUB ExNoun(cmd$,choice(2),nch,that) STATIC
SHARED mhom,nnoun,noun$,nindex(),nhom(),ncode()
ll = 0
ExNoun1:
IF cmd$ = "" THEN ExNoun2
c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(noun$,c$)
IF c = 0 THEN ExNoun2
ln = LEN(c$) - 2
i = VAL(MID$(noun$,c + ln + 2))
cmd$ = MID$(cmd$,ln + 2)
WHILE (MID$(cmd$,1,1) = " ")
cmd$ = MID$(cmd$,2)
WEND
IF ncode(nindex(i)) = -14 THEN that = 1:GOTO ExNoun2 ' Found "that"
IF ncode(nindex(i)) = -15 THEN ' "what's" == "everything that"
IF nch THEN nch = -1:EXIT SUB
choice(1,0) = -11:nch = 1:that = 1
CALL SkipNoun(cmd$)
EXIT SUB
END IF
IF (nhom(i) = 0) THEN ExNoun1 '*** Null word, get next word
IF (nch = 0) THEN '*** Empty context
FOR j = 1 TO nhom(i) '*** Ambiguous
code = ncode(nindex(i) + j - 1)
nch = nch + 1
choice(nch,ll) = ncode(nindex(i) + nch -1)
NEXT j
ll = 1 - ll
GOTO ExNoun1
ELSE '*** Try to resolve ambiguity within old context
newnch = 0
FOR j = 1 TO nch
FOR k = 1 TO nhom(i)
code = ncode(nindex(i)+k-1)
IF choice(j,1-ll) = code THEN
newnch = newnch + 1
choice(newnch,ll) = code
k = mhom
END IF
NEXT k
NEXT j
IF newnch = 0 THEN
nch = -1:REM inconsistent nouns
EXIT SUB
END IF
nch = newnch
ll = 1 - ll
GOTO ExNoun1
END IF
ExNoun2:
IF ll = 0 THEN
FOR i = 1 TO nch
choice(i,0) = choice(i,1)
NEXT i
END IF
END SUB
' Skip noun (skips nouns without looking at meaning)
SUB SkipNoun(cmd$) STATIC
SHARED noun$
ll = 0
SkipNoun1:
IF cmd$ = "" THEN EXIT SUB
c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(noun$,c$)
IF c = 0 THEN EXIT SUB
cmd$ = MID$(cmd$,LEN(c$))
WHILE (MID$(cmd$,1,1) = " ")
cmd$ = MID$(cmd$,2)
WEND
GOTO SkipNoun1
END SUB
' GetNoun() uses ExNoun to return all possible noun code choices,
' and tries to resolve the ambiguity by calling ChooseVisible to
' see if the object is in the room or on the player. If this
' fails, then tries using the vtype1 flag, and then the vtype2
' flag (see ChooseVisible for explanation of vtype.) (vtype1 is
' nounat(verb) and vtype2 is noundef(verb) (see Commands for
' explanation of nounat and noundef.))
' Returns ch = -1 for inconsistent nouns
' Returns ch = -2 for ambiguity not resolved by visual check
' Returns that = 1 if a "that" clause follows
' See ExNoun() and ChooseVisible()
SUB GetNoun(cmd$,choice(2),ch,n,vtype1,vtype2,that) STATIC
SHARED c1()
z = 0
c1(0) = 0:c1(1) = vtype1:c1(2) = vtype2
IF vtype1 <> c1(z) THEN z = z + 1:c1(z) = vtype1
IF vtype2 <> c1(z) THEN z = z + 1:c1(z) = vtype2
och = ch
CALL ExNoun(cmd$,choice(),ch,that)
IF that THEN IF ch = och THEN EXIT SUB
IF ch = 1 THEN
n = choice(1,0)
ELSEIF ch = -1 THEN
EXIT SUB
ELSE '*** Try to resolve ambiguity
FOR i = 0 TO z
CALL ChooseVisible(choice(),ch,c1(i))
IF ch = 1 THEN 'Found it
n = choice(1,0)
EXIT SUB
ELSEIF ch < -1 AND i = 0 THEN 'Can't see anywhere
ch = -2
EXIT SUB
ELSEIF ch <= 0 THEN 'Return last step's ambiguity
ch = -ch
EXIT SUB
END IF
NEXT i
END IF
END SUB
' Get preposition
SUB GetPrep(cmd$,p) STATIC
SHARED prep$,prepn$()
WHILE (1)
IF cmd$ = "" THEN EXIT SUB
c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(prep$,c$)
IF c = 0 THEN EXIT SUB
lp = LEN(c$) - 2
p = VAL(MID$(prep$,c + lp + 2))
cmd$ = MID$(cmd$,lp + 2)
WHILE (MID$(cmd$,1,1) = " ")
cmd$ = MID$(cmd$,2)
WEND
WEND
END SUB
' Routine scans the choice array and returns an array with only
' visible items. Returns the same array with a negative
' nchoice if none of the items are visible.
' If vtype is 1, then only checks to see if object is visible on the
' player, and if 2, then only checks if objects is visible in room,
' but not carried by player. If 0, checks both places.
SUB ChooseVisible(choice(2),nchoice,vtype) STATIC
SHARED mhom
IF nchoice < 2 THEN EXIT SUB
newnchoice = 0
FOR i = 1 TO nchoice
CALL Visible(choice(i,0),vis,vtype)
IF (vis) THEN
newnchoice = newnchoice + 1
choice(newnchoice,1) = choice(i,0)
END IF
NEXT i
IF newnchoice = 0 THEN
nchoice = -nchoice
EXIT SUB
ELSE
nchoice = newnchoice
FOR i = 1 TO nchoice
choice(i,0) = choice(i,1)
NEXT i
END IF
END SUB
' Parses the cmd$ string and returns the next preposition and
' noun (used in a sentence like "get the water that's *in the bottle*")
' Returns -1 in tp if player overrided command in an AskAmbig process
' Returns -2 in tp if player makes a fatal grammatical error
SUB GetThatClause(cmd$,tp,tn) STATIC
SHARED nchoice2()
IF tp THEN GetThatClause1
tn = 0:tp = 0
CALL SkipNoun(cmd$)
CALL GetPrep(cmd$,tp)
GetThatClause1:
IF tp < 1 OR tp > 4 THEN EXIT SUB
nch = 0:ambig = 0:that = 0
GetThatClause2:
CALL GetNoun(cmd$,nchoice2(),nch,tn,0,0,that)
IF that THEN
PRINT"Your language is too complex for me. Please restate."
tp = -2
EXIT SUB
END IF
IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
cmd$ = amb$ ' assume that the player overrided the old command, and
tp = -1 ' return a -1 error flag
EXIT SUB
ELSE
ambig = 0 ' Clear AskAmbig flag
END IF
IF nch = -1 THEN GOSUB Absurd:tp = -2:EXIT SUB
IF nch = -2 THEN GOSUB Mystery:tp = -2:EXIT SUB
IF nch > 1 THEN ' Ask player to resolve ambiguity
CALL AskAmbig(nchoice2(),nch,that)
IF that THEN PRINT"Wait a sec---I'm getting confused. Let's start over from the beginning.":EXIT SUB
PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
GOTO GetThatClause2 ' Try to resolve ambiguity
END IF
END SUB
' Skips a clause of the form preposition-noun
SUB SkipThatClause(cmd$) STATIC
CALL SkipNoun(cmd$)
CALL GetPrep(cmd$,a)
CALL SkipNoun(cmd$)
END SUB
' Attempts to resolve ambiguity by choosing only those
' items in array(,0) that are related to tn by mode tr
' (i.e., only objects that are "in" the "bottle", "on" the "table", etc.)
SUB ResolveThat(array(2),nch,n,tr,tn) STATIC
SHARED par(),rel(),mrel
IF tn<0 THEN EXIT SUB
IF tr<0 OR tr>mrel THEN EXIT SUB
nnch = 0
FOR i = 1 TO nch
IF array(i,0) < 0 THEN
nnch = nnch + 1
array(nnch,1) = array(i,0)
ELSEIF par(array(i,0)) = tn AND rel(array(i,0)) = tr THEN
nnch = nnch + 1
array(nnch,1) = array(i,0)
END IF
NEXT
nch = nnch
FOR i = 1 TO nch
array(i,0) = array(i,1) ' Copy array to position zero
NEXT
IF nch = 1 THEN n = array(1,0)
END SUB
Initialize:
CLS
PRINT"Welcome to "game$"!
PRINT"One moment please . . ."
DEF FNcap$(a$) = CHR$(ASC(a$) AND 223) + MID$(a$,2)
z$ = CHR$(8)
' Stack for routines which recursively search object lists
' (Maximum stack depth 30)
mdepth = 30
DIM cc(mdepth),mc(mdepth)
' General storage arrays for subroutines
mlist = 50
DIM c1(mlist),c2(mlist)
' Read abstract descriptions
RESTORE abstract
READ mabs 'Maximum # of abstract nouns
DIM abstract$(mabs),abstract(mabs)
READ a
WHILE (a <> 0)
READ abstract$(a)
READ a
IF a > nabs THEN nabs = a
WEND
' Read "folded" state
RESTORE fold
READ mfold
DIM fold$(mfold)
nfold = 0
READ f$
WHILE (f$ <> "")
nfold = nfold + 1
fold$(nfold) = f$
READ f$
WEND
' Read verbs
RESTORE Verbs
DIM verb$(2)
nverb = 0
FOR i = 0 TO 2
v = 1
WHILE (v <> 0)
READ v$,v
verb$(i) = verb$(i) + "," + v$ + "," + STR$(v)
IF v > nverb THEN nverb = v
WEND
NEXT i
' Read verb attributes (verbs must be in order!)
RESTORE Commands
DIM reqnoun(1,nverb),defprep(nverb),nounat(1,nverb)
DIM noundef(1,nverb),nounpl(1,nverb)
FOR i = 1 TO nverb
READ reqnoun(0,i),reqnoun(1,i),defprep(i),nounat(0,i),nounat(1,i)
READ noundef(0,i),noundef(1,i),nounpl(0,i),nounpl(1,i)
NEXT i
'*** Set the null verb's "attributes"
nounpl(0,0) = 2:nounpl(1,0) = 2
' Read nouns
RESTORE Nouns
READ mnouns,mcode
DIM nindex(mnouns),nhom(mnouns),ncode(mcode)
noun$ = ""
nnoun = 0
mhom = 0:REM maximum number of homonyms for any noun
nbase = 0:REM start at base of ncode table
code = 0
READ n$
WHILE (n$ <> "")
noun$ = noun$ + "," + n$ + "," + STR$(nnoun)
hom = 0
nindex(nnoun) = nbase
READ code
WHILE (code <> 0)
ncode(nbase) = code
nbase = nbase + 1
hom = hom + 1
READ code
WEND
nhom(nnoun) = hom
IF hom > mhom THEN mhom = hom
nnoun = nnoun + 1
READ n$
WEND
' Read prepositions
RESTORE Prepositions
prep$ = ""
nprep = 0
READ p$
WHILE (p$ <> "")
READ p
nprep = nprep + 1
prep$ = prep$ + "," + p$ + "," + STR$(p)
READ p$
WEND
' Read preposition names
RESTORE Prepnames
DIM prepn$(nprep)
READ p$
nprepn = -1
WHILE (p$ <> "")
nprepn = nprepn + 1
prepn$(nprepn) = p$
READ p$
WEND
imap:
' Read map (see Locations: for details)
PRINT"I am reading the map . . ."
RESTORE map
READ mloc,avdes,mmcond,mfcond,avfcond
DIM map(mloc,9),Llight(mloc),Lon(mloc)
DIM dindex(mloc),des$(mloc * avdes)
DIM mcond(4,mloc),mmes$(mloc)
DIM findex(mloc),fcond(5,mfcond),fdes$(mfcond * avfcond)
REM N,NE,E,SE,S,SW,W,NW,U,D, water, light, lighton?
nloc = 1:ndes = 0:nmcond = 0:nfcond = 0:nfcdes = 0
READ l
WHILE (l <> 0)
nloc = nloc + 1
IF nloc <> l THEN PRINT"MAP IS IN BAD FORMAT AT LOC"nloc:STOP
cmcond = 0 ' Count the number of map cond. in this location
FOR i = 0 TO 9
READ n
IF (n < 0) AND (n > -99) THEN
n = -n
IF n > cmcond THEN cmcond = n
map(l,i) = -nmcond - n
ELSE
map(l,i) = n
END IF
NEXT i
READ Llight(l),Lon(l)
FOR j = 1 TO cmcond ' Read map conditionals (if there are any)
nmcond = nmcond + 1
FOR k = 0 TO 4
READ mcond(k,nmcond)
NEXT k
READ mmes$(nmcond)
NEXT j
dindex(l) = ndes
READ des$(ndes) ' First line is short description (can be NULL)
WHILE (des$(ndes) <> "") ' Succeeding lines are long descriptions
ndes = ndes + 1
READ des$(ndes)
WEND
READ a,b,c,d
findex(l) = nfcond + 1
WHILE (a <> -1) ' Read a flag conditional
nfcond = nfcond + 1
fcond(0,nfcond) = a:fcond(1,nfcond) = b:fcond(2,nfcond) = c
fcond(3,nfcond) = d:fcond(4,nfcond) = nfcdes
READ fdes$(nfcdes)
WHILE (fdes$(nfcdes) <> "")
nfcdes = nfcdes + 1
READ fdes$(nfcdes)
WEND
READ a,b,c,d
WEND
READ l
WEND
dindex(nloc+1) = ndes:fcond(4,nfcond+1) = nfcdes ' Mark end of description lists
findex(nloc+1) = nfcond + 1 ' and mark end of flag lists
' Read flags
' Flag 1 is lamp on/off, flag 2 is daytime/nighttime
RESTORE Flags
READ mflag
nflag = 0
DIM flag(mflag)
READ f
WHILE (f)
IF f>nflag THEN nflag = f
READ flag(f),f
WEND
iobj:
' Read objects
DIM Lfirst(nloc),Llast(nloc),seen(nloc)
RESTORE Objects
READ mobj,mrel,mbot
DIM pre$(mobj),word$(mobj),adj$(mobj),long$(mobj)
DIM lo(mobj),par(mobj),rel(mobj)
DIM first(mrel,mobj),last(mrel,mobj),left(mobj),right(mobj)
DIM size(mobj),opening(mrel,mobj),cap(mrel,mobj),opaque(mrel,mobj)
DIM closed(mobj),openable(mobj)
DIM folded(mobj),foldable(mobj),locked(mobj),holdwater(mobj)
DIM worn(mobj),wearable(mobj),soft(mobj),food(mobj),immobile(mobj)
DIM totw(mobj),totb(mobj),bulk(mrel,mobj)
DIM bottles(mbot)
nbot = -1 ' Keep a list of bottles
' Read objects
nobj = 0
READ n
WHILE (n <> 0)
IF (n > nobj) THEN nobj = n
READ pre$(n),word$(n),adj$(n),long$(n)
READ lo(n),par(n),rel(n)
READ size(n),wei
FOR i = 0 TO mrel
READ opening(i,n)
NEXT i
anycap = 0
FOR i = 0 TO mrel
READ cap(i,n)
anycap = anycap OR cap(i,n)
NEXT i
FOR i = 0 TO mrel
READ opaque(i,n)
NEXT i
READ closed(n),openable(n),folded(n),foldable(n),locked(n)
READ holdwater(n),worn(n),wearable(n),soft(n),food(n),immobile(n)
IF holdwater(n) THEN nbot = nbot + 1:bottles(nbot) = n
totw(n) = wei
totb(n) = size(n)
IF par(n) <> 0 OR immobile(n) = 0 OR anycap <> 0 THEN
IF par(n) THEN
CALL Insert(n,par(n),rel(n))
ELSE
CALL Insert(n,-lo(n),0)
END IF
END IF
READ n: REM next object
WEND
Arrays:
' Arrays hold homonyms for ambiguity resolution
DIM nchoice(mhom + 2,1),nchoice2(mhom + 2,1)
' Arrays hold lists of nouns and objects
DIM lnoun(1,mlist),nlnoun(1),ncount(1),olnoun(mlist)
DIM mnoun(1,mlist),mlnoun(1),mcount(1)
' Commands can be superseded temporarily by other commands (e.g.,
' if you say "wear hat" you must first "take" it; the program will
' automatically do this) But for the sake of the multiple-noun
' sequences, etc., the command must be restored to its original
' form, even if it has been superseded. Thus, you use RecordCommand
' and RestoreCommand to store this activity on a "command stack".
' The Alias() subprogram does this automatically for you.
mrlev = 10 ' Maximum ten (!) levels of command stack
DIM vo(mrlev),po(mrlev),no(mrlev,1)
DIM vo$(mrlev),po$(mrlev),no$(mrlev,1),nno$(mrlev,1)
' Arrays hold the direct object and indirect object
DIM n(1),n$(1),nn$(1)
Initvals:
GOSUB Flags ' Set mnemonic variables
fdindex = 4 ' internal use constant (see Look:)
fseen = 5 ' internal use constant (see SaveGame: and Look:)
' Setup starting values
l = 2:ol = 2:REM You start in room 2
t = flag(tim):REM time is kept by flag variable "tim"
GOSUB ClearCommand:FOR z = 0 TO 1:ncount(z) = 0:nlnoun(z) = 0:NEXT
v = 1:REM "Look" is the first command
v$ = "look"
Player:
maxcap = 15:maxweight = 50:REM Player's capacity, total weight capacity
maxgrab = 20:maxlift = 40:REM Maximum size, weight, player can lift (see Take:)
fat = 20:REM Size of player while sitting (3*fat is size when lying down)
GOTO PreProcess
NewCommand:
rlev = 0 ' Clear command stack
GOSUB RecordCommand
GOSUB ClearCommand
GOSUB ClearList
ncmd$ = "":GOTO InCommand
ContCommand:
rlev = 0 ' Clear command stack
GOSUB RecordCommand
ncmd$ = "":GOTO InCommand
GetCommand:
rlev = 0 ' Clear command stack
IF nlnoun(1) THEN '*** take care of multiple indirect objects
ncount(1) = ncount(1) + 1
IF ncount(1) <= nlnoun(1) THEN
n(1) = lnoun(1,ncount(1))
CALL NameNoun(n(1),n$(1),nn$(1))
PRINT p$" "nn$(1)": ";
GOTO Filter
END IF
END IF
IF nlnoun(0) THEN '*** take care of multiple direct objects
ncount(0) = ncount(0) + 1
IF ncount(0) <= nlnoun(0) THEN
ncount(1) = 1
IF nlnoun(1) THEN n(0) = lnoun(1,1)
n(0) = lnoun(0,ncount(0))
CALL NameNoun(n(0),n$(0),nn$(0))
PRINT nn$(0)": ";
GOTO Filter
END IF
END IF
GOSUB RecordCommand
GOSUB ClearCommand
GOSUB ClearList
InCommand:
PRINT
IF ncmd$ = "" THEN
LINE INPUT"> ";cmd$:PRINT:cmd$ = cmd$ + " "
ELSE
GOSUB waitforesc:IF a$ = CHR$(27) THEN NewCommand
cmd$ = ncmd$
END IF
Parse: ' Take care of grammatical quirks
a = INSTR(cmd$,".") ' Periods
IF (a) THEN
ncmd$ = MID$(cmd$,a+1)
WHILE (MID$(ncmd$,1,1) = " ")
ncmd$ = MID$(ncmd$,2)
WEND
cmd$ = LEFT$(cmd$,a-1) + " "
ELSE
ncmd$ = ""
END IF
a = INSTR(cmd$,",and ") ' Replace commas
WHILE (a)
cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+5)
a = INSTR(cmd$,",and ")
WEND
a = INSTR(cmd$,", and ")
WHILE (a)
cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+6)
a = INSTR(cmd$,", and ")
WEND
a = INSTR(cmd$,",")
WHILE (a)
cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+1)
a = INSTR(cmd$,",")
WEND
WHILE (MID$(cmd$,1,1) = " ") ' Get rid of excess spaces
cmd$ = MID$(cmd$,2)
WEND
Interpret: ' nn is the noun number (0 = direct obj, 1 = indirect obj)
IF cmd$ = "" THEN PRINT"Say what?":GOTO ContCommand
nlnoun(0) = 0:nlnoun(1) = 0 '*** stop multiple noun loops
ocmd$ = cmd$:locmd=LEN(ocmd$)
IF noobj THEN v = 0 '*** See Filter: for origin of noobj flag
CALL GetVerb(cmd$,v,v$)
IF noobj THEN
IF v <> 0 AND v <> vo THEN
vo=v:vo$=v$
GOSUB ClearCommand '*** User can override old verb
v=vo:v$=vo$
ELSE
v=vo
END IF
END IF
IF cmd$ = "" THEN PreProcess
IF noobj THEN InPrep
ambig=0:but=0:cand=0:nch=0:that=0:nn=0
InNoun:
CALL GetNoun(cmd$,nchoice(),nch,n(nn),nounat(nn,v),noundef(nn,v),that)
IF nch = -1 THEN PRINT"I don't understand what you're talking about.":GOTO NewCommand
IF nch = -2 THEN GOSUB Mystery:GOTO NewCommand
IF nn = 0 THEN
IF cmd$<>"" AND nounpl(1,v) = 0 THEN ' default "that" clause?
tn=0:c=0:CALL GetPrep(cmd$,c)
IF c > 0 AND c < 8 THEN
tp=c:that=1:GOTO InThatClause
ELSE ' Message for InPrep not to scan again for a preposition
trp=c
END IF
END IF
END IF
IF that THEN ' "that" clause
tp=0:tn=0
InThatClause:
IF nch = 0 THEN
CALL SkipThatClause(cmd$)
ELSE
CALL GetThatClause(cmd$,tp,tn)
IF tp = -1 THEN Parse
IF tp = -2 THEN NewCommand
IF ambig = 1 AND tn = 0 THEN 'Ambig resolution failed, so
GOTO Parse ' assume player overrided old command and start over
END IF
IF tp < 0 OR tp > 4 OR tn = 0 THEN
IF cmd$ <> "" THEN
PRINT"I don't know what you mean by '"cmd$"'.
GOTO NewCommand
ELSE
PRINT"That's . . . what?" ' Try to resolve ambiguity
PRINT:LINE INPUT"> ";cmd$:cmd$=cmd$+" ":PRINT
ambig=1:GOTO InThatClause
END IF
END IF
CALL ResolveThat(nchoice(),nch,n(nn),tp-1,tn)
IF nch = 0 THEN GOSUB Mystery:GOTO NewCommand
END IF
END IF
IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
cmd$=amb$ ' assume that the player overrided the old command, and
GOTO Parse ' start over
ELSE
ambig = 0 ' Clear AskAmbig flag
END IF
IF nch > 1 THEN ' Ask player to resolve ambiguity
that = 0:CALL AskAmbig(nchoice(),nch,that)
PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
GOTO InNoun ' Try to resolve ambiguity
END IF
IF nch THEN
IF n(nn) = -12 THEN ' Resolve pronoun ambiguity
IF no(0,1) > 0 THEN ' Choose last noun referenced
n(nn)=no(0,1)
ELSEIF no(0,0) > 0 THEN
n(nn)=no(0,0)
ELSE
n(nn)=0
END IF
IF n(nn) <> 0 THEN
CALL NameNoun(n(nn),n$,nn$)
IF nn = 0 THEN
PRINT"("nn$")
ELSE
PRINT"("p$" "nn$")
END IF
END IF
END IF
IF but = 0 THEN ' "and" clause
IF n(nn) = -11 THEN ' this is the "all" noun
na = noundef(nn,v):IF na = 0 THEN na = 3
IF that = 1 AND tp > 0 AND tn > 0 THEN ' everything that's in ...
that = 0
CALL Visible(tn,vis,0)
IF vis = 0 THEN GOSUB Mystery:GOTO NewCommand
' Place test particle in tn, relation tp-1, to see if
' stuff in there is visible or not
lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
CALL Visible(0,vis,0)
IF vis THEN
ThatAgain:
CALL ListSib(first(tp-1,tn),lnoun(),nlnoun(),nn)
ELSE
IF closed(tn) THEN
PRINT"(opening the "word$(tn)" first): ";
CALL Alias("open",8,(tn),0,0):GOSUB OpenIt
GOSUB RestoreCommand
lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
CALL Visible(0,vis,0)
IF vis=0 THEN NewCommand ELSE GOTO ThatAgain
ELSE
GOSUB Mystery:GOTO NewCommand
END IF
END IF
ELSE
IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),nn)
IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),nn)
END IF
IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
ELSEIF n(nn) = -13 THEN ' plural pronoun
IF ncount(nn) = 0 THEN
FOR i = 1 TO onlnoun
nlnoun(nn) = nlnoun(nn) + 1
lnoun(nn,nlnoun(nn)) = olnoun(i)
NEXT
IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
END IF
ELSEIF n(nn) <> 0 THEN
nlnoun(nn) = nlnoun(nn) + 1
lnoun(nn,nlnoun(nn)) = n(nn)
END IF
ELSE '"but" clause
IF n(nn) = -11 THEN PRINT"You humans have a strange way of speaking.":GOTO NewCommand
IF n(nn) = -13 THEN ' plural pronoun
FOR i = 1 TO onlnoun
a = 0
FOR j = 1 TO nlnoun(nn)
IF lnoun(nn,j) = olnoun(i) THEN a=1:nlnoun(nn)=nlnoun(nn)-1
IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
NEXT
NEXT
ELSE ' single word
a = 0
FOR i = 1 TO nlnoun(nn)
IF lnoun(nn,i) = n(nn) THEN a = 1:nlnoun(nn) = nlnoun(nn) - 1
IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
NEXT
END IF
IF nlnoun(nn) THEN n(nn) = lnoun(nn,1) ELSE n(nn) = 0
END IF
ELSE
IF cand = 1 THEN ncmd$ = cmd$+"."+ncmd$:cmd$ = "":GOTO PreProcess
END IF
IF cmd$ = "" THEN PreProcess
InPrep:
lcmd = LEN(cmd$)
c = 0:IF trp THEN c=trp:trp=0 ELSE CALL GetPrep(cmd$,c)
IF c = 0 THEN PreProcess
IF c < 8 AND nn = 0 THEN p = c:ploc = locmd-lcmd ' Record prep location
IF cmd$ = "" THEN PreProcess
IF (c = 8 AND nn = 0 AND n(0) = 0) THEN
ncmd$ = cmd$ + "." + ncmd$
cmd$ = ""
GOTO PreProcess
END IF
IF c = 8 THEN cand = 1:nch = 0:that = 0:GOTO InNoun ' and ...
IF c = 9 THEN but = 1:nch = 0:that = 0:GOTO InNoun ' but ...
IF nn = 1 THEN ' What!? Insert a "that's" and start over
IF warnthat < 3 THEN
warnthat = warnthat + 1
PRINT"(Please use more specific language in the future, e.g.,
PRINT CHR$(34)LEFT$(ocmd$,ploc)"THAT'S "MID$(ocmd$,ploc+1)CHR$(8)CHR$(34)"-Ed.)
END IF
GOSUB ClearCommand:GOSUB ClearList
cmd$ = LEFT$(ocmd$,ploc)+"that's "+MID$(ocmd$,ploc+1)
ocmd$ = cmd$:locmd = LEN(ocmd$)
GOTO Parse
END IF
nn = 1:but = 0:cand = 0:nch = 0:that = 0:GOTO InNoun 'Get indirect object
PreProcess:
nn = 0:p$ = prepn$(p)
FOR i = 0 TO 1
IF n(i) <> 0 THEN CALL NameNoun(n(i),n$(i),nn$(i))
NEXT
IF cmd$ <> "" THEN
cmd$ = LEFT$(cmd$,LEN(cmd$) - 1)
PRINT"I don't know what you mean by '"cmd$CHR$(8)"'.
GOTO NewCommand
END IF
FOR i = 0 TO 1
IF nlnoun(i) = 1 THEN nlnoun(i) = 0
NEXT
FOR i = 0 TO 1
IF nlnoun(i) THEN
IF nounpl(i,v) < 2 THEN
PRINT"You can't use multiple ";
IF i = 1 THEN PRINT"indirect ";
PRINT"objects with '"v$"'!
GOTO NewCommand
END IF
END IF
NEXT
IF nlnoun(0) > 0 OR nlnoun(1) > 0 THEN GetCommand
Filter:
'*** grammatical replacements
IF (n(0)<0) AND (n(0)>=-10) AND (v = 0) THEN v = 6: v$="go"
IF v = 3 THEN IF n(1) <> 0 THEN v = 7 ' "drop xxx on yyy" == "put xxx on yyy"
IF v = 0 AND n(0) = 0 AND n(1) = 0 THEN PRINT"I don't understand.":GOTO NewCommand
FOR i = 0 TO 1
IF n(i) <> 0 AND nounpl(i,v) = 0 THEN
PRINT"You can't use ";
IF i = 1 THEN PRINT"indirect ";
PRINT"objects with '"v$"'!
GOTO NewCommand
END IF
NEXT
IF v = 0 AND n(0) <> 0 THEN
PRINT"What do you want to do with "nn$(0)"?
GOTO ContCommand
END IF
IF v = 0 AND n(1) <> 0 THEN
PRINT". . . "prepn$(p)" "nn$(1)"?
GOTO ContCommand
END IF
FOR i = 0 TO 1
IF reqnoun(i,v) THEN
na = noundef(i,v):IF na = 0 THEN na = 3
IF n(i) = 0 THEN
IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),i)
IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),i)
IF nlnoun(i) = 1 THEN
n(i) = lnoun(i,1):ncount(i) = 1
CALL NameNoun(n(i),n$(i),nn$(i))
IF i = 0 THEN
PRINT"("nn$(i)")
ELSE
IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
PRINT"("p$" "nn$(i)")
END IF
ELSE
IF i = 0 THEN
PRINT FNcap$(v$)" what?":GOTO ContCommand
ELSE
IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
PRINT FNcap$(v$)" "nn$(0)" "p$" what?":noobj = 1:GOTO ContCommand
END IF
END IF
END IF
CALL Visible(n(i),vis,0)
IF vis = 0 THEN CALL CantSee(nn$(i)):GOTO GetCommand
IF reqnoun(i,v) = 2 THEN ' Check physical accessibility
pa = par(n(i))
TryAvail:
CALL Avail(n(i),ava,0)
IF ava = 0 THEN ' Try to open next parent up if still not accessible
IF pa = 0 OR closed(pa) = 0 THEN ToNoAvail
CALL Visible(pa,vis,0):IF vis = 0 THEN ToNoAvail
PRINT"(opening the "word$(pa)" first): ";
CALL Alias("open",8,(pa),0,0):GOSUB OpenIt
GOSUB RestoreCommand
IF closed(pa) <> 0 THEN ToNoAvail
pa = par(pa):GOTO TryAvail
ToNoAvail:
CALL CantGetAt(nn$(i)):GOTO GetCommand
END IF
END IF
END IF
NEXT
FOR i = 0 TO 1
IF nounat(i,v) THEN
IF n(i) < 0 THEN
GOSUB Absurd:GOTO GetCommand
ELSEIF nounat(i,v) = 1 AND n(i) > 0 THEN
IF lo(n(i)) <> 1 THEN
CALL Avail(n(i),ava,2)
IF ava = 0 THEN CALL DontHave(nn$(i)):GOTO GetCommand
PRINT"(taking "nn$(i)" first): ";
CALL Alias("get",2,(n(i)),0,0):GOSUB Take
GOSUB RestoreCommand
IF lo(n)<>1 THEN NewCommand
END IF
END IF
END IF
NEXT
DoCommand:
' The variables n and o hold the values of n(0) and n(1), respectively
' (the direct and indirect object). These variables are used as a
' kind of shorthand to make the verb routines easier to read.
n = n(0):o = n(1)
' See PostProcess for the meaning of the ask flag (set by the verb routine)
ask = 0
IF v = 0 OR v > 33 THEN
PRINT"DoCommand: Unrecognized verb '"v$"', code"STR$(v)".
GOTO PostProcess
END IF
IF v < 6 THEN ON v GOSUB Look,Take,Drop,Inventory,Examine:GOTO PostProcess
IF v < 11 THEN ON v - 5 GOSUB go,Place,OpenIt,CloseIt,Lock:GOTO PostProcess
IF v < 16 THEN ON v - 10 GOSUB Unlock,TurnOn,TurnOff,Wordy,Brief:GOTO PostProcess
IF v < 21 THEN ON v - 15 GOSUB Superbrief,SaveGame,LoadGame,PutOn,TakeOff:GOTO PostProcess
IF v < 26 THEN ON v - 20 GOSUB Wrap,UnWrap,Restart,Again,Empty:GOTO PostProcess
IF v < 31 THEN ON v - 25 GOSUB Fill,Eat,Drink,Sit,Stand:GOTO PostProcess
IF v < 36 THEN ON v - 30 GOSUB Lie,QuitGame,DrinkAll:GOTO PostProcess
PostProcess:
ON ask GOTO ContCommand,NewCommand,Interpret
t = t + 1:flag(tim) = t ' Time marches on . . .
ol = l ' Keep track of where we are
GOTO GetCommand
' Record last command on the command stack (push command stack)
RecordCommand:
vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
FOR z = 0 TO 1
no(rlev,z) = n(z):no$(rlev,z) = n$(z):nno$(rlev,z) = nn$(z)
NEXT
rlev = rlev + 1
RETURN
' Clear current command (clear top of stack)
ClearCommand:
v$ = "":p$ = ""
v = 0:n = 0:p = 0:o = 0
FOR z = 0 TO 1
n(z) = 0:n$(z) = "":nn$(z) = ""
NEXT
' Reset interpreter flags
noobj = 0
RETURN
' Clear and record multiple noun lists
ClearList:
z1 = 0:onlnoun = nlnoun(0):IF nlnoun(1) THEN onlnoun = nlnoun(1):z1 = 1
FOR z = 1 TO onlnoun
olnoun(z) = lnoun(z1,z)
NEXT
FOR z = 0 TO 1
nlnoun(z) = 0:ncount(z) = 0
NEXT
RETURN
' Restore recorded command (pop command stack)
RestoreCommand:
rlev = rlev - 1:IF rlev < 0 THEN rlev = 0
v$ = vo$(rlev):p$ = po$(rlev)
v = vo(rlev):p = po(rlev)
FOR z = 0 TO 1
n(z) = no(rlev,z):n$(z) = no$(rlev,z):nn$(z) = nno$(rlev,z)
NEXT
n = n(0):o = n(1)
RETURN
' Pushes the command stack with a new command
SUB Alias(av$,av,n0,ap,n1) STATIC
SHARED n(),vo(),no(),po()
SHARED vo$(),n$(),nn$(),nno$(),no$(),po$(),prepn$()
SHARED v$,v,n,p,p$,o,rlev
vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
FOR i = 0 TO 1
no(rlev,i) = n(i):no$(rlev,i) = n$(i):nno$(rlev,i) = nn$(i)
NEXT
rlev = rlev + 1
v$ = "":p$ = ""
v = 0:n = 0:p = 0:o = 0
FOR i = 0 TO 1
n(i) = 0:n$(i) = "":nn$(i) = ""
NEXT
v$=av$:v=av:n(0)=n0:n(1)=n1:IF ap THEN p=ap:p$=prepn$(p)
IF n(0) THEN CALL NameNoun(n(0),n$(0),nn$(0))
IF n(1) THEN CALL NameNoun(n(1),n$(1),nn$(1))
n=n(0):o=n(1)
END SUB
Commands:
' The first DATA statement for each verb has the following
' meaning:
'
' DATA require_direct_object?,require_indirect_object?,defaultprep?
'
' The first two numbers have the following meanings:
' 0 - not required
' 1 - must be visible (see Calc:Visible())
' 2 - must be physically accessible (see Calc:Avail())
'
' defaultprep? is either 0 for no default preposition,or a prep number
' (see Prepositions:)
'
' The next line is:
'
' DATA direct_object_location?,indirect_object_location?
'
' 0 - no checking done
' 1 - player must be carrying the item
' 2 - the item should be in the same location as the player
'
' The third line means:
'
' DATA direct_obj_default_location?,indirect_obj_default_location?
'
' The codes are the same as above, except that these are used in the
' "verb all" and "verb what?" ambiguity resolution routines to determine
' where to look. This is usually the same as above, but in some cases
' the verb is *usually* used for one purpose but may be used for another;
' e.g., "get" which is usually used to get objects from the room but
' may be used to get an object out of a container the player is
' carrying. In this case the default (room) is different from the
' required (either room or player).
'
' The fourth means:
'
' DATA number_direct_objects?,number_indirect_objects?
'
' If the number is 0, can have no nouns.
' If 1, can only have a single noun.
' If 2, can have single and plural (no checking is done).
'
' Finally, if the verb wishes to ask a question or report an error,
' the flag 'ask' can be set to the following values:
' 1 - return to input line but keep context (as in "get what?")
' 2 - return to input line (interrupt a multiple-command line)
' (usually used after some error message has been given)
' (throw away context)
' 3 - go to Interpret after returning, and reprocess the
' verb, noun, object codes (see Again:)
'
' See PreProcess:, DoCommand:, and PostProcess:
Look:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
IF l = 0 THEN PRINT"Can't go that way.":l = ol:RETURN
IF map(l,0) <> -99 THEN
CALL CheckLight(flag(1))
IF (flag(1) = 0) THEN PRINT"It's too dark to see.":RETURN
END IF
IF (l > nloc) OR l < 2 THEN
PRINT"You are in room "l", which is manifestly impossible.
RETURN
END IF
' Display description
' This code can be changed to get a description off of a random file
' from disk
longdes = 0
IF dindex(l) <> dindex(l+1) THEN
IF des$(dindex(l)) <> " " THEN PRINT des$(dindex(l))
IF ((seen(l) = 0 OR flag(verbose) = 1 OR v = 1) AND flag(verbose) <> -1) OR des$(dindex(l)) = " " THEN
longdes = 1 ' We are printing the long description
FOR i = dindex(l) + 1 TO dindex(l + 1) - 1
IF des$(i) = "z" THEN
GOSUB waitforkey
ELSE
PRINT des$(i)
END IF
NEXT i
seen(l) = 1 'Jack was here
END IF
END IF
' Display conditional descriptions
FOR i = findex(l) TO findex(l + 1) - 1
CALL EvalCond(fcond(0,i),fcond(1,i),fcond(2,i),true)
IF true AND ((fcond(3,i) AND 1) <> 0 OR longdes = 1) AND NOT ((fcond(3,i) AND 1)= 0 AND flag(verbose) = -1) THEN
IF (fcond(3,i) AND 2) = 0 OR fcond(fseen,i) = 0 THEN ' Check for one-time-only
FOR j = fcond(fdindex,i) TO fcond(fdindex,i + 1) - 1
IF fdes$(j) = "z" THEN
GOSUB waitforkey
ELSE
PRINT fdes$(j)
END IF
NEXT j
fcond(fseen,i) = 1 ' We've seen this one now
END IF
END IF
NEXT
IF Lfirst(l) THEN
PRINT"Here, you see:
CALL Contents(Lfirst(l),3,0)
END IF
' Check for forced move
IF map(l,0) = -99 THEN
CALL EvalCond(map(l,1),map(l,2),map(l,3),true)
IF true THEN nl = map(l,4) ELSE nl = map(l,5)
IF nl = -99 THEN
l = ol ' Bounce back
RETURN
ELSE
l = nl ' Don't want absurd negative locations
PRINT
GOTO Look ' Describe new location
END IF
END IF
RETURN
waitforesc:
PRINT"[press any key or ESC]";:GOTO getkey
waitforkey:
PRINT"[press any key]";
getkey:
a$ = INKEY$
WHILE(a$ = "")
a$ = INKEY$
WEND
' Erase message
PRINT z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$;
RETURN
Take:
DATA 2,0,0
DATA 0,0
DATA 2,0
DATA 2,0
IF n > 0 THEN
IF holdwater(n) = 2 THEN
CALL ListBottles(c1(),a)
IF a = 0 THEN PRINT"You don't have anything to hold the water.":RETURN
IF a > 1 THEN
PRINT"Put the water in what?
v=7:v$="put":p=1:p$="in"
ask=1
RETURN
END IF
CALL Alias("fill",26,c1(0),6,(n)):GOSUB Fill
GOSUB RestoreCommand
RETURN
END IF
END IF
IF n < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Absurd:RETURN
IF lo(n) = 1 AND par(n) = 1 THEN PRINT"You already have "nn$(0)"!":RETURN
IF totw(n) > maxlift THEN PRINT FNcap$(nn$(0))" is too heavy to lift.":RETURN
IF totb(n) > maxgrab THEN PRINT FNcap$(nn$(0))" is too big to get a hold of.":RETURN
IF totw(n) + totw(1) > maxweight THEN PRINT"Your load is too heavy.":RETURN
IF totb(n) + bulk(1,1) > maxcap THEN PRINT"Your load is too bulky.":RETURN
CALL Remove(n)
CALL Insert(n,1,1)
PRINT"Taken."
RETURN
Drop:
DATA 1,0,0
DATA 0,0
DATA 1,0
DATA 2,1
IF n < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Cannot:RETURN
IF lo(n) <> 1 THEN CALL DontHave(nn$(0)):RETURN
CALL Avail(n,ava,0)
IF ava = 0 THEN
CALL CantGetAt(nn$(0)):RETURN
ELSEIF ava = -1 THEN
PRINT"You can't get "nn$(0)" out.":RETURN
END IF
IF holdwater(n) = 2 THEN
IF par(n) = 0 THEN
PRINT"Something's wrong here.
ELSE
CALL Alias("pour out",25,(par(n)),0,0):GOSUB Empty
GOSUB RestoreCommand
RETURN
END IF
ELSE
CALL Remove(n)
CALL Insert(n,-l,0)
worn(n) = 0
PRINT"Dropped.
END IF
RETURN
Inventory:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
IF sat>0 THEN PRINT"(you are sitting on the "word$(sat)".)
IF sat<0 THEN PRINT"(you are lying on the "word$(-sat)".)
CALL Contents(1,0,0)
IF first(1,1) = 0 THEN PRINT"You are carrying nothing.
RETURN
Examine:
DATA 1,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n = -20 THEN GOSUB Inventory:RETURN
IF n < 0 OR long$(n) = "" THEN
PRINT"You see nothing unusual about "nn$(0)".":RETURN
END IF
PRINT long$(n)
IF openable(n) THEN
IF closed(n) THEN
PRINT FNcap$(nn$(0))" is closed.
ELSE
PRINT FNcap$(nn$(0))" is open.
END IF
END IF
IF folded(n) THEN PRINT FNcap$(nn$(0))" is "fold$(folded(n))".
IF n = 7 AND lampon = 1 THEN PRINT"The lamp is on.
CALL Contents(n,0,1) '*** List what's related to it, if anything
RETURN
go:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 1,0
IF n = 0 THEN PRINT"Which way do you want to "v$"?":ask = 1:RETURN
IF n > 0 THEN GOSUB Absurd:RETURN
nl = map(l,-n-1)
IF nl < 0 THEN ' Map conditional
i = -nl
CALL EvalCond(mcond(0,i),mcond(1,i),mcond(2,i),true)
IF true THEN
nl = mcond(3,i)
ELSE
IF mmes$(i) <> "" THEN PRINT mmes$(i)
nl = mcond(4,i)
IF nl = l THEN RETURN
IF mmes$(i) <> "" THEN PRINT
END IF
END IF
ol = l:l = nl
GOTO Look
Place:
DATA 2,2,1
DATA 1,0
DATA 1,0
DATA 2,1
mode = p - 1
IF mode = 1 THEN GOTO Wrap
IF n > 0 THEN
IF holdwater(n) = 2 AND holdwater(o) = 1 THEN
CALL Alias("fill",26,(n(1)),6,(n(0))):GOSUB Fill
GOSUB RestoreCommand
RETURN
END IF
END IF
IF n < 0 OR o < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Absurd:RETURN
IF cap(mode,o) = 0 THEN GOSUB Cannot:RETURN
IF mode = 0 THEN
IF holdwater(n) = 2 THEN PRINT FNcap$(nn$(1))" won't hold water.":RETURN
IF holdwater(n) = 0 THEN
IF holdwater(first(0,o))=2 THEN
PRINT"You can't put anything in "nn$(1)", there's water in it.
RETURN
END IF
END IF
f = 0:IF folded(o) THEN f = 1
IF (openable(o) <> 0 AND closed(o) <> 0) OR f = 1 THEN 'try to open o
PRINT"(opening "nn$(1)" first):
CALL Alias("open",8,(n(1)),0,0):GOSUB OpenIt
GOSUB RestoreCommand
IF (openable(o)<>0 AND closed(o)<>0) OR folded(o)<>0 THEN RETURN
PRINT"(then, putting "nn$(0)" "p$" "nn$(1)"): ";
IF f THEN mode=2:p$="on"
END IF
END IF
IF totb(n) > opening(mode,o) THEN
PRINT FNcap$(nn$(0))" won't fit "p$" "nn$(1)".
RETURN
END IF
IF totb(n) + bulk(mode,o) > cap(mode,o) THEN
PRINT FNcap$(nn$(0))" won't fit; there's too much already "p$" "nn$(1)".
RETURN
END IF
IF n = o THEN GOSUB Cannot:RETURN
' Can't put stuff in clothing that you're wearing on your head (e.g. hats)
IF mode = 0 AND (worn(o) AND 2) <> 0 THEN
PRINT"You can't put anything in "nn$(1)"; you're wearing it.":RETURN
END IF
IF rel(n) = mode AND par(n) = o THEN
PRINT FNcap$(nn$(0))" is already "p$" "nn$(1)"!":RETURN
END IF
CALL Inside(o,n,ins,rel) 'Don't want to make n a descendant of itself
IF ins THEN PRINT"But "nn$(1)" is "prepn$(rel + 1)" "nn$(0)"!":RETURN
CALL Remove(n)
CALL Insert(n,o,mode)
worn(n) = 0
IF mode = 0 AND first(2,n) <> 0 THEN
PRINT"Done, but everything that was on top of "nn$(0)" falls off inside
PRINT nn$(1)".
CALL Tumble(n)
ELSE
PRINT"Done.
END IF
RETURN
OpenIt:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF folded(n) THEN GOTO UnWrap
IF openable(n) = 0 THEN GOSUB Cannot:RETURN
IF locked(n) THEN
PRINT"(trying to unlock "nn$(0)" first)
CALL Alias("unlock",11,(n(0)),0,0):GOSUB Unlock
GOSUB RestoreCommand
IF locked(n) THEN RETURN
PRINT"(then, proceeding . . .)
END IF
IF closed(n) = 0 THEN PRINT FNcap$(nn$(0))" is already open.":RETURN
closed(n) = 0
IF first(0,n) <> 0 AND (opaque(0,n) <> 0) THEN
PRINT"Opening "nn$(0)" reveals:
CALL Contents(n,0,2)
ELSE
PRINT FNcap$(nn$(0))" is now open.
END IF
RETURN
CloseIt:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF openable(n) = 0 THEN
IF foldable(n) THEN GOTO Wrap ELSE GOSUB Cannot:RETURN
END IF
IF closed(n) THEN PRINT FNcap$(nn$(0))" is already closed.":RETURN
closed(n) = 1
PRINT FNcap$(nn$(0))" is now closed.
RETURN
Lock:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
PRINT"Don't know how to lock that.
RETURN
Unlock:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
PRINT"Don't know how to unlock that.
RETURN
TurnOn:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF n <> lamp THEN GOSUB Cannot:RETURN
IF flag(lampon) THEN PRINT FNcap$(nn$(0))" is already on.":RETURN
flag(lampon) = 1
PRINT FNcap$(nn$(0))" is now on.
RETURN
TurnOff:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF n <> lamp THEN GOSUB Cannot:RETURN
IF flag(lampon) = 0 THEN PRINT FNcap$(nn$(0))" is already off.":RETURN
flag(lampon) = 0
PRINT FNcap$(nn$(0))" is now off.
RETURN
Wordy:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
flag(verbose) = 1
PRINT"I shall use long descriptions.
RETURN
Brief:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
flag(verbose) = 0
PRINT"Brief descriptions.
RETURN
Superbrief:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
flag(verbose) = -1
PRINT"Superbrief.
RETURN
SaveGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 2,0
LINE INPUT"Save to file? ";file$
ON ERROR GOTO Saverr
cantopen = 0
1000 OPEN file$ FOR OUTPUT AS 1
1010 PRINT#1, dataformat$ ' Version number to verify format (see Initialize:)
' Write out globals
PRINT#1, "GLOBAL"
WRITE#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat
' Write out flags
PRINT#1, "FLAGS"
WRITE#1, nflag
FOR i = 0 TO nflag
WRITE#1, flag(i)
NEXT
' Write out objects
PRINT#1, "OBJS"
WRITE#1, nobj,mrel
FOR i = 0 TO nobj
WRITE#1, lo(i),par(i),rel(i)
FOR j = 0 TO mrel
PRINT#1, first(j,i)
NEXT
FOR j = 0 TO mrel
PRINT#1, last(j,i)
NEXT
WRITE#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
WRITE#1, totw(i),totb(i)
FOR j = 0 TO mrel
PRINT#1, bulk(j,i)
NEXT
NEXT i
' Write out locations
PRINT#1, "LOCS"
PRINT#1, nloc
FOR i = 0 TO nloc
WRITE#1, Lfirst(i),Llast(i),Lon(i)
NEXT i
' Write out flag conditionals
PRINT#1, "FLAGCONDS"
PRINT #1,nfcond
FOR i = 0 TO nfcond
PRINT#1, fcond(fseen,i)
NEXT
' End marker
PRINT#1, "END"
PRINT:PRINT"Done.
EndSave:
ON ERROR GOTO 0
IF cantopen = 0 THEN CLOSE 1
RETURN
Saverr:
IF ERL = 1000 THEN
cantopen = 1
PRINT"Can't open'"file$"'!
ELSE
PRINT"Disk error while saving game. Aborting save.
END IF
RESUME EndSave
LoadGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
LINE INPUT"Enter name of saved game: ";file$
ON ERROR GOTO Loaderr
cantopen = 0:okay = 0
2000 OPEN file$ FOR INPUT AS 1
2010 INPUT#1, a$
IF a$ <> dataformat$ THEN AbortLoad
' Load constants
INPUT#1, a$:IF a$ <> "GLOBAL" THEN AbortLoad
INPUT#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat
' Load flags
INPUT#1, a$:IF a$ <> "FLAGS" THEN AbortLoad
INPUT#1, nflag
FOR i = 0 TO nflag
INPUT#1, flag(i)
NEXT
' Load objects
INPUT#1, a$:IF a$ <> "OBJS" THEN AbortLoad
INPUT#1, nobj,mrel
FOR i = 0 TO nobj
INPUT#1, lo(i),par(i),rel(i)
FOR j = 0 TO mrel
INPUT#1, first(j,i)
NEXT
FOR j = 0 TO mrel
INPUT#1, last(j,i)
NEXT
INPUT#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
INPUT#1, totw(i),totb(i)
FOR j = 0 TO mrel
INPUT#1, bulk(j,i)
NEXT
NEXT i
' Load locations
INPUT#1, a$:IF a$ <> "LOCS" THEN AbortLoad
INPUT#1, nloc
FOR i = 0 TO nloc
INPUT#1, Lfirst(i),Llast(i),Lon(i)
NEXT i
' Load flag conditionals info
INPUT#1, a$:IF a$ <> "FLAGCONDS" THEN AbortLoad
INPUT#1, nfcond
FOR i = 0 TO nfcond
INPUT#1, fcond(fseen,i)
NEXT
PRINT:PRINT"Done.":okay = 1
EndLoad:
ON ERROR GOTO 0
IF cantopen = 0 THEN CLOSE 1
IF okay THEN Look
RETURN
AbortLoad:
PRINT"Saved game is in wrong format (shouldn't have read '"a$"').
PRINT"Aborting.
GOTO EndLoad
Loaderr:
IF ERL = 2000 THEN
cantopen = 1
PRINT"Can't open'"file$"'!
ELSE
PRINT"Disk error while loading game.
END IF
RESUME EndLoad
PutOn:
DATA 2,0,0
DATA 1,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF wearable(n) = 0 THEN GOSUB Cannot:RETURN
IF worn(n) <> 0 THEN PRINT"You're already wearing "nn$(0)"!":RETURN
worn(n) = wearable(n)
CALL Remove(n)
CALL Insert(n,1,0)
PRINT"You are now wearing "nn$(0)".
RETURN
TakeOff:
DATA 2,0,0
DATA 1,0
DATA 1,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF wearable(n) = 0 THEN GOSUB Absurd:RETURN
IF worn(n) = 0 THEN PRINT"You're not wearing "nn$(0)".":RETURN
dropflag = 0
IF totb(n) + totb(1) > maxcap OR totw(n) + totb(1) > maxweight THEN
PRINT"You're carrying too much already, you'll have to drop something first.
RETURN
END IF
IF totw(n) > maxlift OR totb(n) > maxgrab THEN
PRINT"You take off "nn$(0)", but you fumble with it and it falls.
worn(n) = 0
PRINT FNcap$(nn$(0))": ";
GOTO Drop
END IF
worn(n) = 0
CALL Remove(n)
CALL Insert(n,1,1)
PRINT"You are now no longer wearing "nn$(0)".
RETURN
Wrap:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,1
IF n < 0 OR o < 0 THEN GOSUB Absurd:RETURN
IF o <> 0 AND p <> 1 AND p <> 3 AND p <> 6 THEN GOSUB Absurd:RETURN
IF o <> 0 THEN
CALL Avail(o,ava,0)
IF ava = 0 THEN CALL CantGetAt(nn$(1)):RETURN
END IF
IF o = 0 THEN o = n:n(1) = n(0):n = 0:n(0) = 0:nn$(1) = nn$(0)
IF foldable(o) = 0 OR cap(1,o) = 0 THEN GOSUB Absurd:RETURN
IF folded(o) THEN
PRINT FNcap$(nn$(1))" is already "fold$(folded(o))".
RETURN
END IF
IF bulk(0,o) THEN
PRINT"You can't wrap anything with "nn$(1)"; there's something in it.
RETURN
END IF
IF worn(o) THEN
PRINT"(taking off "nn$(1)" first):
CALL Alias("take off",20,(n(1)),0,0):GOSUB TakeOff
GOSUB RestoreCommand
IF (worn(n)) THEN RETURN
PRINT"(then, proceeding . . .)
END IF
IF n = 0 THEN
IF bulk(2,o) > cap(1,o) THEN
PRINT FNcap$(nn$(1))" isn't big enough to wrap what's on it.
RETURN
END IF
CALL RemList(o,2,head)
CALL Concat(head,o,1)
ELSE
IF totb(n) > cap(1,o) THEN
PRINT FNcap$(nn$(1))" isn't big enough to wrap "nn$(0)".
RETURN
END IF
CALL Remove(n)
CALL Insert(n,o,1)
END IF
folded(o) = foldable(o)
PRINT"Done.
RETURN
UnWrap:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n < 0 THEN GOSUB Absurd:RETURN
IF foldable(n) = 0 THEN GOSUB Absurd:RETURN
IF folded(n) = 0 THEN PRINT FNcap$(nn$(0))" isn't "fold$(foldable(n))".":RETURN
folded(n) = 0
tumb = (bulk(1,n) > cap(2,n))
CALL RemList(n,1,head)
IF tumb THEN
PRINT"When you open "nn$(0)", everything in it falls out.
CALL Concat(head,-l,0)
ELSE
IF head <> 0 THEN
PRINT"Opening "nn$(0)" reveals:
CALL Contents(head,3,0)
CALL Concat(head,n,2)
ELSE
PRINT"Opened.
END IF
END IF
RETURN
Restart:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
LINE INPUT"Start over from the beginning? (Are you sure?) >";a$
IF LEFT$(a$,1) = "y" THEN RUN
PRINT:PRINT"Okay.
RETURN
Again:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
cmd$ = ocmd$:ask = 3:RETURN
Empty:
DATA 2,0,1
DATA 1,0
DATA 1,2
DATA 2,1
IF n<0 OR o<0 THEN GOSUB Absurd:RETURN
IF p THEN IF p<>1 THEN GOSUB Cannot:RETURN
IF holdwater(n)=2 THEN c=n-1 ELSE c=n
IF holdwater(c)=0 THEN
' Place test particle inside n, to see if
' stuff in there is visible or not
lo(0) = l:par(0) = c:rel(0) = 0
CALL Visible(0,vis,0)
IF vis THEN
Empty1:
mlnoun(0) = 0
CALL ListSib(first(0,c),mnoun(),mlnoun(),0)
IF mlnoun(0) = 0 THEN
PRINT FNcap$(nn$(0))" is empty.
RETURN
END IF
ELSE
IF closed(c) THEN
PRINT"(opening "nn$(0)" first): ";
CALL Alias("open",8,c,0,0):GOSUB OpenIt
GOSUB RestoreCommand
lo(0)=l:par(0)=c:rel(0)=0
CALL Visible(0,vis,0)
IF vis=0 THEN RETURN ELSE GOTO Empty1
ELSE
GOSUB Mystery:GOTO NewCommand
END IF
END IF
FOR emptyi=1 TO mlnoun(0)
PRINT"the "word$(mnoun(0,emptyi))": ";
CALL Alias("drop",3,mnoun(0,emptyi),0,0):GOSUB Drop
GOSUB RestoreCommand
NEXT
RETURN
END IF
IF bulk(0,c) = 0 THEN PRINT"The "word$(c)" is empty.":RETURN
IF par(c)<>1 THEN
PRINT"(taking out the "word$(c)" first): ";
CALL Alias("take out",2,c,0,0):GOSUB Take
GOSUB RestoreCommand
IF par(c)<>1 THEN RETURN
END IF
IF closed(c) THEN
PRINT"(opening the "word$(c)" first):
CALL Alias("open",8,c,0,0):GOSUB OpenIt
GOSUB RestoreCommand
IF closed(c) THEN RETURN
END IF
IF o THEN
IF holdwater(o) = 2 THEN d=o-1 ELSE d=o
amt = bulk(0,c)
CALL Fill(d,amt)
CALL Fill(c,-amt)
IF bulk(0,c)<>0 THEN PRINT"You fill up the "word$(d)" with some water from the "word$(c)".":RETURN
PRINT"You empty the "word$(c)" completely into the "word$(d)".
ELSE
CALL Empty(c)
PRINT"The water pours out and evaporates.
END IF
RETURN
Fill:
DATA 2,2,6
DATA 1,0
DATA 1,2
DATA 2,1
IF n<0 OR (p<>6 AND p<>7) THEN GOSUB Absurd:RETURN
IF holdwater(o) = 1 THEN w=o+1 ELSE w=o
IF holdwater(n)<>1 OR holdwater(w)<>2 THEN
CALL Alias("put",7,w,1,n):GOSUB Place
GOSUB RestoreCommand
RETURN
END IF
IF size(w)=0 THEN PRINT"The "word$(w-1)" is empty.":RETURN
amt=size(w):max=amt
CALL Fill(n,amt)
IF amt<max THEN
IF amt=0 THEN
PRINT FNcap$(nn$(0))" is already full.":RETURN
ELSE
PRINT"You fill up "nn$(0)" with some water from the "word$(w-1)".
END IF
END IF
CALL Fill(w-1,-amt)
RETURN
Eat:
DATA 2,0,0
DATA 1,0
DATA 0,0
DATA 2,0
IF n<0 THEN GOSUB Absurd:RETURN
IF food(n) = 0 THEN GOSUB Cannot:RETURN
' Please modify the code below if you want to handle food more realistically
CALL Remove(n) ' The food just disappears
ON RND(1) * 3 GOTO Eat1,Eat2
PRINT"Eaten.":RETURN
Eat1:
PRINT"Mmm, mmm, that was good!":RETURN
Eat2:
PRINT"Ugh, a little stale, but edible.
RETURN
Drink:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n<0 THEN GOSUB Absurd:RETURN
wat = -1
CALL Fill(n-1,wat)
IF wat = -1 THEN
IF bulk(0,n-1) = 0 THEN
PRINT "You drink all of "nn$(0)".
ELSE
PRINT"You drink some of "nn$(0)".
END IF
ELSE
PRINT"There's nothing to drink.
END IF
RETURN
Sit: ' This code handles both sitting and lying down
DATA 0,0,0
DATA 0,2
DATA 0,2
DATA 0,2
sitflag = 1
Sit1: ' The Lie: code jumps to here with sitflag = 3
IF o < 0 THEN GOSUB Absurd:RETURN
IF p <> 3 THEN GOSUB Cannot:RETURN
IF sat THEN
IF sitflag = 1 THEN
IF sat = o THEN
PRINT"You're already sitting on "nn$(1)".
RETURN
END IF
ELSE
IF -sat = o THEN
PRINT"You're already lying on "nn$(1)".
RETURN
END IF
END IF
IF ABS(sat) <> o THEN
PRINT"(standing up first):
CALL Alias("stand up",30,0,0,0):GOSUB Stand
GOSUB RestoreCommand
IF (sat) THEN RETURN
PRINT"(then, proceeding . . .)
END IF
END IF
IF cap(2,o) < fat * sitflag THEN
PRINT FNcap$(nn$(1))" is too small for you to "v$" on.
ELSE
IF soft(o) = 0 THEN
PRINT FNcap$(nn$(1))" is very uncomfortable, but you "v$" on it anyway.
ELSE
PRINT"You "v$" on "nn$(1)".
IF soft(o) = 2 THEN PRINT"It's very comfortable.
END IF
IF sitflag = 1 THEN sat = o ELSE sat = -o
END IF
RETURN
Stand:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0
IF sat = 0 THEN PRINT"You're already standing.":RETURN
sat = 0
PRINT"You get up.
RETURN
Lie:
DATA 0,0,0
DATA 0,2
DATA 0,2
DATA 0,2
sitflag = 3:GOSUB Sit1
RETURN
QuitGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n = 0 THEN n = -22
IF n <> -22 THEN GOSUB Absurd:RETURN
LINE INPUT"Quit the game? (Are you sure?) >";a$
IF LEFT$(a$,1) <> "y" THEN PRINT"Okay.":RETURN
LINE INPUT"Save the game first? ";a$
IF LEFT$(UCASE$(a$),1) = "Y" THEN GOSUB SaveGame
PRINT"Okay, bye!
END
RETURN ' In case the player does a "cont"
DrinkAll:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0
IF n<0 THEN GOSUB Absurd:RETURN
wat = -bulk(0,n-1)
CALL Fill(n-1,wat)
IF wat < 0 THEN
PRINT "You drink all of "nn$(0)".
ELSE
PRINT"There's nothing to drink.
END IF
RETURN
'*** Error detection marker
DATA "Z"
map:
' Location 1 is reserved to hold object 1, which holds everything the
' player is carrying (in his/her hands)
'
' The data format is as follows:
'
' DATA loc, N,NE,E,SE,S,SW,W,NW,U,D, light, lighton?
'
' (OPTIONAL:
' DATA flag1,comp1,value1,loctrue1,locfalse1,"falsemessage"
' DATA flag2,comp2,value2,loctrue2,locfalse2,"falsemessage"
' . . . and so on, one line for each map conditional here)
'
' DATA short description
' DATA long description line 1
' DATA long description line 2
' DATA . . .
' DATA long description last line
' DATA ""
'
' (OPTIONAL:
' DATA flagnum,comp,value,verbose
' DATA description lines
' DATA ""
' . . . repeat as often as desired)
'
' DATA -1,0,0,0 ' End of this description
'
' Loc is the location number, and is used as a checking mechanism only;
' unlike elsewhere, the map MUST be in sequential order, starting with 2.
' Location 1 is reserved to hold "object" number 1 which contains
' everything the player is carrying (see Objects:).
'
' The following numbers are direction codes for each direction.
'
' The light flag is 0 if there is no light source (cave), 1 if there is
' natural light, and 2 if there is electric light (switchable on/off).
'
' Lighton? is usually used to flag whether or not the electric light
' is on or off. If this flag is non-zero, the value returned by CheckLight()
' will be this value.
'
' Then come the map conditional DATA statements, the short and long
' descriptions, the conditional descriptions, then the 0,0,0,0 end marker.
'
' DEFINITIONS:
'
' CONDITIONAL:
' A "conditional" is a triplet "flagnum,comp,value" which
' is evaluated as TRUE when flag(flagnum) < value, flag(flagnum) = value,
' flag(flagnum) > value, or flag(flagnum) <> value, depending on whether
' comp is -1, 0, 1, or 2, respectively. (See Calc:EvalCond(). See
' also Flags:)
'
' DIRECTION CODES:
' If positive, these are simply location numbers.
' (If the first number is -99, this is a "forced move" or a "bounceback"
' location; the codes are interpreted differently; see below for details.)
'
' MAP CONDITIONAL:
' If the direction code is a negative number (from -10 to -1), the code
' is an index to a "map conditional". -1 refers to the first map
' conditional in the location, -2 to the second, etc. For each map
' conditional in a location, there must be a DATA statement: (following
' the direction and status codes)
'
' DATA flagnum,comp,value,trueloc,falseloc,"falsemessage"
' ^--(conditional)--^
'
' If the conditional is true, the player lands in trueloc, no questions
' asked. If false, the program prints "falsemessage" and then a blank line
' (if "falsemessage" is NOT null), and then the player goes to falseloc
' (which can be 0, which ends up with a "Can't go that way.")
'
' For example,
' DATA 54, 41,0,3,0,27,0,-1,0,0,0, 0,0,0
' DATA 12,0,1,97,54,"The snake blocks your way."
' means, this is location 54. You can go north to 41, east to 3,
' and south to 27. If flag 12 is equal to 1, you can go west to
' location 97; otherwise "The snake blocks your way" and you stay
' in location 54.
'
' FORCED MOVE LOCATIONS, BOUNCEBACK:
' If the location number for "north" is -99, then the location
' is a "forced move" location; the player simply gets to see the
' description and then is moved immediately to a new location:
'
' DATA loc, -99,flagnum,cond,value,loctrue,locfalse,0,0,0,0, 0,0,0
' ^---conditional---^
'
' The player is immediately moved to loctrue if the conditional is
' true, and locfalse if false. If either locations are -99, the player
' is simply "bounced back" to his/her former location (combining this
' with the map conditionals described above allows you to have
' map conditionals that print out arbitrarily long messages). Note:
' since flag zero is set to a constant value of 1, you can always
' force a specific move or bounceback by testing flag zero for value 1.
'
' DESCRIPTIONS:
' Finally, you have the short description, which is a one-line
' "title" for the room. Then follows the long description, which ends
' with a NULL string. If the first line is a null string, NO description
' is printed (except possibly for the conditional descriptions, below.)
' Normally the long description is only printed when the player
' encounters a location for the first time, when flag(verbose) = 1,
' or when the player says "look". At other times only the short description
' is printed.
' In addition, if the short description is simply a space " ", the
' full description will always be printed.
' Any line in the long description that is just a single "z" will
' cause the "press any key to continue" message.
'
' CONDITIONAL DESCRIPTIONS:
'
' DATA flagnum,comp,value,verbosity
' ^---conditional---^
' DATA "First line"
' . . .
' DATA "Last line"
' DATA ""
'
' If the conditional is true, and the "verbosity" condition is satisfied,
' the description is printed. If verbosity is 0, the description is printed
' only if the long description (see above) is printed. If 1, then
' it doesn't matter whether or not the long description is printed. If 2,
' then the conditional description is printed only ONCE, but only when
' the long description is printed, and if 3, the conditional is printed
' only once, but irregardless of whether or not the long description is
' printed as well.
'
' Any line in the conditional description that is just a single "z"
' will cause the "press any key to continue" message.
'
' Finally, DATA -1,0,0,0 will mark the end of a description.
' All the parameters below can be changed to suit your particular style
' Maximum location number
DATA 100
' Average number of lines of description per location
DATA 5
' Maximum number of map conditionals
DATA 50
' Maximum number of flag conditionals
DATA 50
' Average number of lines of description per flag conditional
DATA 3
MapList:
' Begin with location 2
' -99 means forced move
' "0,0,0" means test flag 0 to equal 0, which is ALWAYS TRUE, so
' go to location 3 immediately
' this v---v is the conditional (always true)
DATA 2, -99,0,0,0,3,0,0,0,0,0, 0,0
DATA "Welcome . . .
DATA " "
DATA " You awaken to find yourself in a completely foreign
DATA "land, filled with creatures and peoples you have never even
DATA "imagined. After wandering for some time, you come to a deserted
DATA "castle on a hilltop, overlooking the sea. You climb up to the
DATA "tower and have a good night's sleep, unaware of the adventures
DATA "that lie ahead . . .
DATA " "
DATA " You awake from a deep sleep, hoping to find yourself safe
DATA "at home, but, alas, you are still in the---
DATA "z"
DATA ""
DATA -1,0,0,0
' Go down to location 4 --v
DATA 3, 0,0,0,0,0,0,0,0,0,4, 1,0
' Natural lighting --^
DATA "Castle Tower
DATA "From here you can see the raging green ocean, stretching out
DATA "to the horizon to the north. The tower itself is ravaged by
DATA "time, and the walls of the tower are crumbling and exposed.
DATA "A spiral stairway winds down the inside of the walls of this
DATA "round tower.
DATA ""
DATA -1,0,0,0
' Two map conditionals here, indicated by "-1" and "-2"
' West to location 8--v v--Go up to location 3
DATA 4, 0,0,-1,0,-2,0,8,0,3,0, 1,0
' Natural lighting --^
' If flag 20 equals 1, go to location 6. Otherwise go to 4, print "closed."
DATA 20,0,1,6,4,"The door is closed."
' If flag 21 equals 1, go to location 7. Otherwise print "Can't go that..."
DATA 21,0,1,7,0,""
DATA "Tower Base
DATA "This is a high-ceilinged room, some 25 feet, with the only light
DATA "coming through the doorway to the west and dimly from upstairs.
DATA "There is a heavy wooden door, about fifteen feet tall, in the
DATA "eastern wall. The walls of made of finely-hewn stone, set with
DATA "a minimum of mortar, and are surprisingly well-preserved.
DATA "A spiral staircase winds up the perimeter. The staircase was
DATA "cut from the very stone walls themselves.
DATA ""
' On the first day, print this message once
' (flag(4) is the day number, verbosity code 2 means print only once)
DATA 4,0,1,2
DATA "Here in the base of the tower you find evidence that the people
DATA "who built this castle were more highly technically advanced
DATA "than you originally thought: there are steel brackets mounted
DATA "in the walls. Funny that you didn't recall seeing them last
DATA "night, but after all it was dark and you were tired and disoriented.
DATA ""
' Secret passageway
' If flag 21 equals 1, print the following description
DATA 21,0,1,0
DATA "A solid black rectangle, about the size of a door, hovers
DATA "as if attached to the southern wall. It appears pitch black,
DATA "nevertheless a slight breeze emerges from it.
DATA ""
' Continuation of long description
' If flag 0 equals 0 (always true), and the long description was
' printed (verbosity 0), print the following
DATA 0,0,0,0
DATA "You hear the surf pounding on the rocks in the distance.
DATA ""
DATA -1,0,0,0
' Example of a bounceback location
' -99 means forced move
' If flag 0 equals 0 (always true), go to location -99, which means
' "bounce back"
' this v---v is the conditional (always true)
DATA 5, -99,0,0,0,-99,0,0,0,0,0, 0,0
DATA " "
DATA "There is a flash of intense blue light and you are blinded
DATA "for a moment before the air clears and you realize you have
DATA "been jolted back into the tower base by some sort of force field.
DATA ""
DATA -1,0,0,0
' One map conditional, marked by "-1"
' Going west --v checks map conditional 1 first
DATA 6, 0,0,0,0,0,0,-1,0,0,0, 0,0
' Lamp lighting --^
' Map conditional 1 (for this location)
' if flag 20 equals 1, goto 4, otherwise stay in 6, print "door shut."
DATA 20,0,1,4,6,"The door is firmly shut.
DATA "Strange Grotto
DATA "This is more a hollowed-out cave than a room. The walls are
DATA "simply made of soft dirt that seems to have been recently dug,
DATA "except for the stone wall to the west in which is embedded a
DATA "heavy wooden door. The walls seem to be held together only by
DATA "a tightly woven net of roots which seem to ooze from everywhere
DATA "and appear almost as if they are moving.
DATA ""
' If flag 20 equals 1, print the following
' (verbosity code 0 means only print when the long description is also)
DATA 20,0,1,0
DATA "The door is ajar.",""
DATA -1,0,0,0
' One map conditional here, marked by "-1"
' If you go north, check map conditional 1 first
' Otherwise, stay in location 7, no matter where you go
DATA 7, -1,7,7,7,7,7,7,7,7,7, 0,0
DATA 21,0,1,4,7,""
' " " first means always print the long description
DATA " "
DATA "FLYING
DATA "You have a vision, that you are flying way above the clouds,
DATA "with nothing about you but the earth far below, a mountain range
DATA "to the east, and a bright afternoon sun.
DATA 21,0,1,0
DATA "A dark rectangle hovers in the air directly north of you.",""
DATA -1,0,0,0
' Go east to location 3, west to location 5
DATA 8, 0,0,4,0,0,0,5,0,0,0, 0,0
DATA "Entry Hall
DATA "This is what was obviously once an entry hall. The doorway to
DATA "the outside lies to the west. A fountain, made from exquisite
DATA "marble, lies in the center of the room, and still contains water.
DATA ""
DATA -1,0,0,0
' End marker
DATA 0
Flags:
' The flag format is simple:
'
' DATA flag,value,flag,value, . . .
'
' Where flag is a flag number and value is its initial value. If
' not otherwise specified, the value is zero.
'
' The first value is the maximum number of flags (mflag).
'
DATA 40
' Note: the convention followed here is that flags 0-19 are "system"
' flags, common to all adventures that use this kernal. At the moment,
' only flags 0-7 are being used. Flags 20 and up are "adventure" flags,
' which are set and reset by the individual program. In the example
' "adventure" given here, flags 20 and 21 are used.
'
' This program segment is also called as a subroutine by Initialize:
' to set various mnemonic variables to index the flag() array
'
' Note: flag zero should never be changed from its value of zero
' Flag zero is used as a constant value for flag conditionals
flag(0) = 0
' Lamp on?
lamp = 2:lampon = 2 'lamp is object 2
DATA 2,1
' Daytime? 2-moonlight, 3-twilight, 4-daytime
day = 3
DATA 3,4
' Day number
date = 4
DATA 4,1
' Time (aka "t") (See PostProcess:)
tim = 5
DATA 5,1
' Detail level (see Wordy: Brief: and Superbrief:)
verbose = 6
DATA 6,0
' Random (varies from 0 to 99) call RollDice to set this flag (Calc:)
' Note: EvalCond() automatically calls RollDice if flag(random) is tested
random = 7
RANDOMIZE TIMER ' Seed generator with timer value
DATA 7,0
CALL RollDice
' End marker
DATA 0
RETURN
Objects:
'
' The list of objects is as follows:
' data Number,prefix,word,adjectives,long description
' data location,parent,relation
' data size,weight,inopening,wrapopening,onopening,underopening
' data containcapacity,wrapcapacity,surfacecapacity,undercapacity
' data containopaque,wrapopaque,surfaceopaque,underopaque
' data closed?,openable?,folded?,foldable?,locked?
' data holdwater?,worn?,wearable?,soft?,food?,immobile?
' data special 1,special 2,special 3
'
' This information is placed in the following arrays, indexed by Number:
'
' pre$(),word$(),adj$(),long$()
' lo(),par(),rel()
' { see below for first(rel,),last(rel,),left(), and right() }
' size(),{see below for totw()},opening(rel,),cap(rel,),opaque(rel,)
' closed(),openable(),folded(),foldable(),locked()
' holdwater(),worn(),wearable(),soft(),food(),immobile()
' special(0/1/2,)
'
' More information is placed in the following arrays:
'
' totw(),totb(),bulk(rel,)
'
' The Number identifies the object to the program. You can delete and
' add objects without changing these Numbers, and in fact the objects
' can be listed in any order.
'
' The prefix contains "a" or "an" and any modifiers to be used when
' listing the object (as in Contents()). --> pre$()
'
' Word is a single word describing the type of object. --> word$()
'
' Adjectives are used by the program to ask the player to
' distinguish one object from another. --> adj$()
'
' The long description is for use when the player examines an
' object. --> long$()
'
' The location is the room number the object is in. This is 0 if the
' object does not exist, and 1 if the player is carrying it. This means
' actual room numbers start with the number 2. --> lo()
'
' The parent is the container the object is in, or zero. (The parent
' is zero if it is in a room.) --> par()
'
' The "relationship" to the parent is given by:
' MODE DESCRIPTION
' 0 - inside
' 1 - wrapped by
' 2 - on top of
' 3 - underneath (only for objects under tables, etc., NOT for
' objects stacked on top of each other---use 2 for that)
' --> rel()
'
' (The maximum number of relationships is stored in the mrel variable.
' This is set by the second number in the first DATA statement, below.
' The relationship is also referred to as "mode" elsewhere in the program.)
'
' Size --> size(). The size of the object and everything
' on top of and wrapped by (relations 1 and 2) the object --> totb()
' The total bulk contained in relation rel to object n. --> bulk(rel,n)
' Weight --> ?. You give the weight of the object by itself, but the only
' number which is stored is the total weight of the object and everything
' inside it and on top of it. This is stored in --> totw()
' (The weight of the object by itself is implicit in the totw() array,
' so it is not stored anywhere.)
' Inopening, wrapopening, onopening, underopening --> opening(rel,obj).
' where rel varies from 0 to 3. This is how big an object can
' fit in, wrapped by, on top of, and underneath an object. The
' "onopening" is usually equal to the surfacecapacity, below.
' Containcapacity, wrapcapacity, surfacecapacity, undercapacity -->
' cap(rel,obj), where rel varies from 0 to 3. This is how much stuff
' total can fit in relation to the object in these ways.
' Containopaque, wrapopaque, surfaceopaque, underopaque --> opaque(rel,obj).
' This determines whether or not objects inside, wrapped by, on top of,
' or underneath an object are not visible.
'
' Examples:
' A bottle might have inopening 1 (narrow opening) but containcapacity
' 3 (so it can contain 3 objects of size 1). It would be transparent,
' i.e. containopaque = 0.
' A purse, on the other hand, might have inopening 4, capacity 6,
' and containopaque = 1 (opaque unless the purse is open).
' A rug might have wrapcapacity 10, but surfacecapacity 30 (you can
' wrap about a third of what you can stuff on top of it lying flat.)
' A table might have surfacecapacity 30 and undercapacity 30
' (you can stuff as much stuff on it as underneath it). However, a book
' might have surfacecapacity 3, so a table would not fit on the book,
' but you could certainly put the book under the table.
'
' (Size, weight, opening, capacity are in arbitrary units you can devise.
' My convention is that most ordinary objects have a size of at least
' 2, so that really small objects can be distinguished from them by having
' a size of 1.)
'
' Holdwater? --> holdwater().
' The codes are as follows:
' 0 - cannot hold water
' 1 - can hold water
' 2 - is water
' ALL OBJECTS WHICH HOLD WATER MUST BE FOLLOWED BY their own personal
' water object (i.e. holdwater() = 2). This object is resized
' as water is added to and removed from the container.
' Currently, the program allows an object to hold either water or objects,
' but not both at the same time. (In a revision that can handle
' "wetness" this restriction could be lifted. I *have* thought out
' algorithms for handling wetness; it would require major
' revisions of almost every subprogram, so I decided to
' release this "dry" version of AmigaVenture for those of you who
' do not require wetness in your adventures. If you are interested
' in adding such code (remember, you have to handle evaporation, weight,
' etc., without slowing down the program too much) please email me (USENET)
' at mitsu@well.UUCP through July 1987, and at harvard!mitsu (I think)
' from August 1987, and I'll mail you my ideas for how to go about
' implementing it within AmigaVenture.)
'
' Closed? --> closed()
' Locked? --> locked()
'
' Folded? --> folded()
' Foldable? --> foldable()
' (Using the following codes:
' 0 - not foldable
' 1 - rolled up/rollable
' 2 - folded up/foldable
' 3 - tied up/tieable)
'
' Worn? --> worn()
' Wearable? --> wearable()
' (Using the following codes:
' 0 - not wearable
' 1 - on hand
' 2 - on head, neck, ears
' 4 - on torso (backpacks, jackets, shirts)
' 8 - around waist (belts)
' 16 - on legs)
'
' Soft? --> soft() is 1 for a chair or sofa type soft, and 2 for a bed
' soft. An object can be used as a piece of furniture if its surface is
' large enough.
'
' Food? --> food() Whether or not it is edible, and how nutritious.
' Arbitrary units. Currently the food just disappears when eaten,
' and has no effect. Modify the Eat: routine for your personal system.
'
' Liquid? --> liquid() Whether or not the object is a liquid. All such
' objects MUST be preceded by an object that can "holdwater".
' Similarly, all objects that "holdwater" must be followed by a
' liquid. Currently the only liquid is water.
'
' Immobile? --> immobile() objects cannot be moved, removed, etc. (like
' doors, etc.) In future revisions, this might contain a value
' describing the degree of immobility (from 0-free, 1-nails/hinges,
' 2-mortar, 3-plasteel, etc.) Currently, if an "immobile" object
' that has *no* interior or surface (no capacity in any of the four
' relations) and is lying free in a room (no parent), it is NOT linked into
' the list of objects in that room, and will NOT appear in the description
' of objects in the room (i.e., will not appear in the Here, you see:
' list.) The object should be described in the textual description of the
' room. Good uses for this would be for stairways, bookshelves, and the
' like. You don't want such things in the "Here, you see:" list, but
' if the player has a reason to refer to them, you don't want the
' program to say "I see no stairwell here." or worse "I don't know
' what you mean by 'stairwell.'"
'
' Please note the special importance of object 1, as described below.
'
' Feel free to add to this list. If you add to the list, simply
' change the Initialize: routine and update the object data statements.
' Perhaps someone can come up with an IFF-style format for storing
' object descriptions, and people could write adventures that
' allowed you to take objects from one adventure to the next. But
' that is a whole different ball of wax. (How would you Number them,
' for example?)
'
' Of course, to save memory, this list and the whole Initialize: routine
' should be placed in a separate program and run *before* the program,
' and the program could just read in the results from a disk file. Note
' that you must copy the Insert() and Setloc() subprograms to such
' an "initialization" program. This would also be much faster. However,
' while developing an adventure, it is much more handy to have the
' object list in the program, so you can "recompile" the object list
' immediately as you modify your adventure. Another neat idea would be
' to write an AmigaVenture Object Editor, which could have all sorts
' of interesting features (standard object types, etc. so you don't
' have to specify all these attributes over and over for each object.)
'
' This list is meant only as a guide to a fairly complete, albeit simple,
' system for defining objects and their relationships. One could imagine
' arbitrarily extending this list of attributes to any desired degree
' of realism; however, you should consider how much the added
' attribute actually adds to the realism and play value of your
' adventure versus the effort and program space taken to take care of
' all the relationships the such attributes might entail (for example,
' wetness).
'
' NOTE TO THE PROGRAMMER:
' Objects are kept track of in the following way:
' The arrays lo(), par(), first(rel,), last(rel,), left(), and right()
' contain information about doubly-linked lists of objects embedded
' in a tree structure.
'
' lo(obj) is the room the object is in. (0 if it is in limbo. Note
' the significance of location 1, the player's special location.)
'
' first(rel,obj) holds the first in the list of objects in, wrapped by, on,
' or under object "obj", or zero if none. The "rel" index is 0, 1, 2,
' and 3, respectively.
'
' Lfirst(loc) (see Map:) holds the first in the list of objects lying free
' in location "loc".
'
' last(rel,obj) holds the last in the list of objects in, wrapped by, on,
' or under object "obj", or zero if none. The "rel" index is the same
' as above.
'
' Llast(loc) (see Map:) holds the last in the list of objects lying free
' in location "loc".
'
' par(obj) holds the parent of the object (0 if it is lying free)
' rel(obj) holds the relation. (0, 1, 2, 3 for in, wrapped, on, under.)
' (Ex.:If object 7 is on top of object 3, then par(7) = 3, rel(7) = 2 (on).)
' (Ex.:If object 4 is lying free in room 17, then lo(4) = 17, par(4) = 0,
' and rel(4) = 0.)
'
' right(obj) holds the next in the list of objects.
'
' left(obj) is the *previous* object in the list.
'
' As below:
'
' Parent (Bag) ---------------------------------\
' | (RELATION 0, in) | Last
' V V
' First (Fruit) Right -> (Sandwich) Right -> (Rock) Right -> Zero
'Zero <- Left <- Left <- Left
'
' The paradigm is the program keeps track of a whole bunch of little
' lists of objects. Each list is either lying free in a room,
' or inside, on top of, wrapped by, or underneath another object.
' EVERY OBJECT keeps track of the following information about their
' list: the parent of the list (0 if lying free), the relation the list
' is in to the parent (0, 1, 2, 3 for in, wrapped, on, under), the
' location number the list resides in (0 for limbo, 1 for player, 2 ...
' for a map location).
'
' The Remove(), Insert(), RemList() and Concat() subprograms handle
' the list operations automatically. They also update the totw(), totb()
' and bulk(rel,) arrays. ALWAYS use these routines to move objects
' around, NEVER directly modify the list arrays yourself, to ensure that
' all the lists and arrays remain consistent. It took a long time to
' debug these arrays, and a lot of redundant information is kept track
' of for program speed, so take advantage of these routines. Descriptions
' of the routines are found near their implementations (after Lists:).
' Maximum number of objects (can be changed at will)
DATA 100
' The largest relationship number (in == 0, on, under, wrap == 3)
DATA 3
' The largest number of water containers (can be changed at will)
DATA 10
' NOTE: Object number 1 is reserved for containing all the objects the
' player is carrying. This object is placed in location 1, and may not
' be moved. Also, no other object should be placed in location 1.
'
' Items being carried by the player should be related to object 1 in
' mode 1 (normally "wrapped by"). Items being *worn* by the player should
' be related to object 1 in mode 0.
'
' FOR OBJECT NUMBER 1 ONLY:
'
' RELATION DESCRIPTION
' -------- -----------
' 0 Objects being worn
' 1 Objects being carried
'
' Objects carried thus must start with 1,1,1,...
' Objects worn must start with 1,0,1,...
ObjList:
DATA 1,,you,,
DATA 1,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,,0
' The program currently assumes the variable "lamp" is the object
' number of the lamp, and the flag number "lampon" determines whether
' it is on or off. See Flags:, Calc:CheckLight(), and also TurnOn:
' and TurnOff:
DATA 2,a brass,lamp,brass,"The lamp is worn from use but still serviceable.
DATA 1,1,1, 5,5, 0,0,2,0, 0,0,2,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
DATA 3,a,sandwich,ham and cheese,"It's a ham and cheese sandwich.
DATA 1,7,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,0
DATA 5,a small,purse,satin,"The purse is made of satin.
DATA 4,0,0, 3,2, 6,0,2,0, 6,0,2,0, 1,1,0,0, 0,1,0,0,0,0, 0,0,0,0,0
DATA 6,a pearl,earring,pearl,"The earring is made of three exquisite pearls.
DATA 4,5,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
DATA 7,a brown,bag,small paper,"It's just a small paper lunch sack.
DATA 1,1,1, 3,2, 4,2,4,0, 4,2,4,0, 1,1,0,0, 1,1,0,2,0,0, 0,0,0,0,0
DATA 8,a diamond,earring,diamond,"The earring is made of two precious diamonds.
DATA 3,0,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
DATA 10,a glass,bottle,glass,"It's an old Coke bottle.
DATA 3,0,0, 1,1, 1,0,1,0, 2,0,1,0, 0,0,0,0, 0,1,0,0,0,1, 0,0,0,0,0
DATA 11,some,water,"",""
DATA 3,10,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
DATA 12,an elfin,hat,elfin,"It's made of old, dirty green felt.
DATA 1,1,0, 2,2, 3,1,2,0, 3,1,2,0, 0,1,0,1, 0,0,0,2,0,0, 2,2,1,0,0
DATA 13,a small Oriental,rug,small Oriental,"The rug is well-worn from use.
DATA 4,0,0, 10,8, 0,7,20,0, 0,7,20,0, 0,0,0,1, 0,0,0,1,0,0, 0,0,1,0,0
DATA 14,a large,backpack,frame,"The label says 'REI.'
DATA 3,0,0, 10,10, 10,0,5,0, 20,0,5,0, 1,0,0,0, 1,1,0,0,0,0, 0,4,1,0,0
DATA 15,a long,rope,long,"The rope is made from hemp.
DATA 4,14,0, 4,3, 0,0,10,0, 0,0,10,0, 0,0,0,0, 0,0,0,0,0,0, 0,8,0,0,0
DATA 16,a,table,wooden,"The table is simply constructed from wood.
DATA 4,0,0, 70,50, 0,0,15,20, 0,0,20,20, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
DATA 17,some steel,brackets,steel,"The brackets are heavy-duty and appear good as new.
DATA 4,0,0, 10,10, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
DATA 18,a spiral,staircase,spiral,"The staircase is somewhat crumbling, but still quite useable.
DATA 4,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
DATA 19,a marble,fountain,marble,"The fountain is made of striated marble.
DATA 8,0,0, 200,300, 100,0,0,0, 100,0,0,0, 0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,1
DATA 20,some,water,"",""
DATA 8,19,0, 100,100, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
' (End marker)
DATA 0
Nouns:
' The list of nouns goes simply
'
' data noun,object 1,object 2, . . .,0
'
' for each noun. The list of objects are all the objects the noun
' could possibly refer to.
'
' The "noun" could also be an adjective. The interpreter will
' ask for futher clarification if there is still unresolved ambiguity.
'
' Negative numbers refer to features or directions or other
' abstractions which do not have objects associated with them.
'
' This list must be all single words, no spaces.
'
' Maximum number of nouns, maximum number of homonyms
DATA 150,300
DATA the,0,a,0,an,0,those,0,these,0,for,0,is,0,are,0,by,0
DATA north,-1,0,n,-1,0,northeast,-2,0,ne,-2,0,east,-3,0,e,-3,0
DATA southeast,-4,0,se,-4,0,south,-5,0,s,-5,0,southwest,-6,0,sw,-6,0
DATA west,-7,0,w,-7,0,northwest,-8,0,nw,-8,0
DATA up,-9,0,u,-9,0,down,-10,0,d,-10,0
DATA upstairs,-9,0,downstairs,-10,0,ascend,-9,0,descend,-10,0
' Nouns from -11 to -19 are reserved as special words for use by the
' interpreter. Do not change them without changing the interpreter also
DATA all,-11,0,everything,-11,0,it,-12,0,him,-12,0,her,-12,0,them,-13,0
DATA that,-14,0,that's,-14,0,that're,-14,0
DATA what,-15,0,what's,-15,0,what're,-15,0
DATA i,-20,0,me,-20,0,myself,-20,0,self,-20,0,my,-20,0
DATA you,-21,0,yourself,-21,0,your,-21,0
DATA game,-22,0
DATA lamp,2,0,brass,2,0
DATA ham,3,0,cheese,3,0,sandwich,3,0
DATA small,5,7,0,satin,5,0,purse,5,0
DATA pearl,6,0,earring,6,8,0
DATA brown,7,0,paper,7,0,bag,7,0
DATA diamond,8,0
DATA glass,10,0,bottle,10,0,Coke,10,0
DATA water,11,20,0
DATA elfin,12,0,felt,12,0,old,12,0,dirty,12,0,green,12,0,hat,12,0
DATA small,13,0,Oriental,13,0,well-worn,13,0,worn,13,0,rug,13,0
DATA large,14,0,frame,14,0,REI,14,0,backpack,14,0,pack,14,0
DATA long,15,0,hemp,15,0,rope,15,0
DATA wooden,16,0,table,16,0,wood,16,0
DATA steel,17,0,brackets,17,0
DATA stairs,18,0,staircase,18,0,spiral,18,0,stairway,18,0
DATA marble,19,0,fountain,19,0
' (End marker)
DATA "",0
' Abstract words like directions, etc., (any noun associated
' with no concrete moveable Object).
' The format is:
' DATA code,word,code,word,etc. (this is the same as
' the Objects format, but with only one descriptor).
abstract:
' Maximum number of abstract nouns (changeable, of course)
DATA 50
DATA 1,north,2,northeast,3,east,4,southeast,5,south
DATA 6,southwest,7,west,8,northwest,9,up,10,down
DATA 11,everything
DATA 13,water
DATA 20,yourself,21,me
DATA 22,the game
' (End marker)
DATA 0,""
fold:
DATA 3
DATA rolled up,folded up,tied up
' (End marker)
DATA ""
Verbs:
'
' The list of verbs goes:
'
' data verb,number,verb,number, . . .
'
' The "number" refers to the number of the verb, which must correspond
' to the number used by DoCommand when it goes to the appropriate
' command in its ON GOTO statement. See DoCommand.
'
' Verbs of three words in length are placed first,
' followed by a data "",0. Then verbs of two words, followed
' by a data "",0. Finally all single-word verbs.
'
' (an unlimited number of verbs are possible).
'
' Please reserve verb numbers 1-49 for kernal verbs, common to
' all adventures. This allows upgrades of the adventure kernal
' to be separated from adventure-specific commands. If you update
' the kernal, please use verbs 1-49; use verbs 50 and up for
' magic words, etc. which would not be used in another adventure.
' This allows other people to be able to take advantage of your
' kernal upgrades without having to wade through adventure-specific
' code. Currently verbs 1-29 are being used.
'*** Three-word verbs
DATA let go of,3,get rid of,3,do it again,24,do it over,24
DATA i give up,32,I give up,32
DATA "",0
'*** Two-word verbs
DATA look at,5,look around,1,pick up,2,get out,2,take out,2,put down,3
DATA get me,3
DATA turn on,12,turn off,13,save game,17,load game,18
DATA put on,19,take off,20,wrap up,21,fold up,21,tie up,21,roll up,21
DATA start over,23,repeat last,24,do again,24,do over,24,over again,24
DATA pour out,25,fill up,26,eat up,27,gobble up,27
DATA sit down,29,stand up,30,get up,30,lie down,31
DATA quit game,32,give up,32,end game,32,drink all,33,drink up,33,slurp up,33
DATA "",0
'*** One-word verbs
DATA look,1,see,1,l,1
DATA get,2,take,2
DATA drop,3,release,3
DATA inventory,4,i,4
DATA examine,5,read,5
DATA go,6,walk,6,run,6,hop,6,skip,6,jump,6
DATA put,7,place,7
DATA open,8,close,9,lock,10,unlock,11
DATA activate,12,deactivate,13
DATA wordy,14,verbose,14,brief,15,superbrief,16
DATA save,17,load,18,restore,18,record,17
DATA wear,19,don,19
DATA wrap,21,fasten,21,unwrap,22,restart,23
DATA again,24,repeat,24
DATA empty,25,pour,25,fill,26
DATA eat,27,munch,27,consume,27,gobble,27,drink,28,quaff,28,slurp,28
DATA sit,29,stand,30,lie,31
DATA quit,32
' (End marker)
DATA "",0
' The preposition codes are 1 more than the relationship codes
' for object lists (see Objects: 0 = in, 1 = wrapped by, et cetera).
Prepositions:
DATA in,1,into,1,inside,1,wrapped,2,lying,3,on,3,onto,3,under,4,underneath,4
DATA to,5,with,6,from,7,and,8,then,8,but,9,except,9,not,9
' (End marker)
DATA "",0
Prepnames: 'Starting with preposition zero (null)
DATA . . .,inside,wrapped by,on,underneath,to,with
' (End marker)
DATA ""